From 331bf67177c5f9abaac44864939b4ee782a5fd01 Mon Sep 17 00:00:00 2001 From: oliskoli Date: Wed, 28 Sep 2005 00:33:08 +0000 Subject: [PATCH] New windows-gui, initial release --- win32/gui-2/GPSBabelGUI.ico | Bin 0 -> 766 bytes win32/gui-2/GPSBabelGUI2.dof | 84 + win32/gui-2/GPSBabelGUI2.dpr | 54 + win32/gui-2/about.dfm | Bin 0 -> 1899 bytes win32/gui-2/about.pas | 56 + win32/gui-2/common.pas | 269 ++ win32/gui-2/filter.dfm | Bin 0 -> 7227 bytes win32/gui-2/filter.pas | 323 ++ win32/gui-2/gnugettext.pas | 2903 ++++++++++++++++++ win32/gui-2/gnugettextD4.pas | 292 ++ win32/gui-2/locale/de/LC_MESSAGES/default.po | 473 +++ win32/gui-2/locale/fr/LC_MESSAGES/default.po | 476 +++ win32/gui-2/main.dfm | Bin 0 -> 22046 bytes win32/gui-2/main.pas | 570 ++++ win32/gui-2/readme.dfm | Bin 0 -> 652 bytes win32/gui-2/readme.pas | 63 + win32/gui-2/template.po | 481 +++ win32/gui-2/utils.pas | 210 ++ 18 files changed, 6254 insertions(+) create mode 100644 win32/gui-2/GPSBabelGUI.ico create mode 100644 win32/gui-2/GPSBabelGUI2.dof create mode 100644 win32/gui-2/GPSBabelGUI2.dpr create mode 100644 win32/gui-2/about.dfm create mode 100644 win32/gui-2/about.pas create mode 100644 win32/gui-2/common.pas create mode 100644 win32/gui-2/filter.dfm create mode 100644 win32/gui-2/filter.pas create mode 100644 win32/gui-2/gnugettext.pas create mode 100644 win32/gui-2/gnugettextD4.pas create mode 100644 win32/gui-2/locale/de/LC_MESSAGES/default.po create mode 100644 win32/gui-2/locale/fr/LC_MESSAGES/default.po create mode 100644 win32/gui-2/main.dfm create mode 100644 win32/gui-2/main.pas create mode 100644 win32/gui-2/readme.dfm create mode 100644 win32/gui-2/readme.pas create mode 100644 win32/gui-2/template.po create mode 100644 win32/gui-2/utils.pas diff --git a/win32/gui-2/GPSBabelGUI.ico b/win32/gui-2/GPSBabelGUI.ico new file mode 100644 index 0000000000000000000000000000000000000000..76a19fd4f8255c3c2e0030659d9d33beef9973bc GIT binary patch literal 766 zcmcIiF%H5o47?(Sj!euQc?Lhjqo380p;8{vg(omXm@{cn9JL!bJ=@o_<3tM3aSg)> zZjS?SX1ovsaV0t&=>eg(Z9MIDk^== z(brrR-n7=kGZyS|FRkm94Pn1_9vj@&{Vek)X3sr76}#{0>`!K??oXB*o+4*Us85kk m*3>tgd_|60Q=T9Wr>!GKZPJhaQ~cYeIjd$aTQpA>P5 z2m85v`OqPcG9R0SIF;g~q|*pHxf<^aYus3P#u_4i9*aA?8~-qt&hxO&!m2p)nQ7H} z+aC3K(=5=g@OY3|)RUJAzQ+Qw!@Ooo#1CWX==sR2i&p%P*kXbEJT#N8pBF)qx@@V) z1CcGXXxL-Id~5q@F?aaPIVtSq4ysR`RMe~IEV=%X7u30Q*r`bCj>wDgcTzt+ryZ79 z-mltK8uaWc3%y1(UlXUvO4+X$LPiBEV;q)M;XM!0&6O^%x*=mh0nnkR97N+xm>+hc z_HxBLWqz;1!rj1a8K0&QV+62F5>AB%%(uEh6t7O5K`?U$SsX{77^UTLY%%A1&A_y% zAB|7t*?{@wK6p11wZU^9u-nAGoy}(LegMd}%Y&W>`z}&j4z1}x3 z1GpZHuKVyGBMWdR1t#k&BB9a&vP-Ucdg0oSghl9zOgFdWK|kb4Xsi z7((BW42MHKe)_f}=j^ySC&~W2BnL0&MNyLSldq@jD=FLGOZf%(T)iersWqj3kaAB+ zDL{*<3}}W@U&_8xC3y-l8K_;y)GtzgrUySEB#l~TP5mV0u~OejS<~A3RZOXG;v zH82868x>7+sjdKg4M_GP4QSfx8sb|Yk)V7e&lD_oH6}p~z2Tk#$uT~o0nGtgfGbE^$ z2Y|GbE@14Q6rHj$rR+6&=d)T@5DRl^~SKRCooPs-VJib*-8-qoZkLbX~}d zPG)U_!OdvY>7^cxX4fy&8rJ#jVq!Ao^aw>~6@LA?-|j$Kd^(RM|Wif_J8> zY#eIpoib~@H>tAG`03Sjg@ccf355>+Mn&`UsAwieTjP!cc*o2^)#qU^ZPNAue%mbC Wjus`8Rms90e4)&RTD!alxa407_3eHD literal 0 HcmV?d00001 diff --git a/win32/gui-2/about.pas b/win32/gui-2/about.pas new file mode 100644 index 000000000..247c594c4 --- /dev/null +++ b/win32/gui-2/about.pas @@ -0,0 +1,56 @@ +unit about; + +{ + Copyright (C) 2005 Olaf Klein, o.k.klein@t-online.de + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111 USA +} + +interface + +uses + gnugettextD4, + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Buttons, ExtCtrls; + +type + TfrmAbout = class(TForm) + pnClient: TPanel; + Image1: TImage; + StaticText1: TStaticText; + StaticText2: TStaticText; + pnBottom: TPanel; + BitBtn1: TBitBtn; + procedure FormCreate(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + frmAbout: TfrmAbout; + +implementation + +{$R *.DFM} + +procedure TfrmAbout.FormCreate(Sender: TObject); +begin + gnugettextD4.TranslateComponent(SELF); +end; + +end. + \ No newline at end of file diff --git a/win32/gui-2/common.pas b/win32/gui-2/common.pas new file mode 100644 index 000000000..e4f40d16b --- /dev/null +++ b/win32/gui-2/common.pas @@ -0,0 +1,269 @@ +unit common; + +{ + Copyright (C) 2005 Olaf Klein, o.k.klein@t-online.de + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111 USA +} + +interface + +uses + Windows, SysUtils, Classes, Messages; + +const + WM_STARTUP = WM_USER + 1; + +const + SREG_TARGET_DIR = 'Target:Directory'; + SREG_SOURCE_DIR = 'Source:Directory'; + + SREG_TARGET_DEV = 'Target:Device'; + SREG_SOURCE_DEV = 'Source:Device'; + + SREG_SOURCE_FMT = 'Source:FileFormat'; + SREG_TARGET_FMT = 'Target:FileFormat'; + + SREG_SOURCE_SER = 'Source:DeviceFormat'; + SREG_TARGET_SER = 'Target:DeviceFormat'; + +const + Profile: array[0..8] of string = + ('?', + SREG_SOURCE_DIR, + SREG_SOURCE_FMT, + SREG_SOURCE_DEV, + SREG_SOURCE_SER, + SREG_TARGET_DIR, + SREG_TARGET_FMT, + SREG_TARGET_DEV, + SREG_TARGET_SER); + +type + PFileInfo = ^TFileInfo; + TFileInfo = record + Descr: string; + Ext: string; + internal: string; + Capas: Integer; + end; + +type + TCapabilities = class(TStringList) + private + FList: TStrings; + procedure AddFormat(const Line: string); + function GetList: TStrings; + procedure SetList(const Value: TStrings); + public + function CanReadAny(Index: Integer): Boolean; + function CanWriteAny(Index: Integer): Boolean; + function GetDescr(Index: Integer): string; + function GetExt(const Descr: string): string; + function GetCaps(const Descr: string): Integer; + function GetName(const Descr: string): string; + function IsDevice(Index: Integer): Boolean; + function IsFile(Index: Integer): Boolean; + property + List: TStrings read GetList write SetList; + end; + +type + eGPSBabelError = class(Exception); + +var + gpsbabel_exe: string; + +implementation + +{ TCapabilities } + +procedure TCapabilities.AddFormat(const Line: string); +var + index: Integer; + buff: array[0..1023] of Char; + cin, cend: PChar; + i: Integer; + + scaps: string; + ext: string; + comment: string; + name: string; + internal: string; + + caps: Integer; + + info: PFileInfo; + +begin + StrPCopy(buff, Line); + StrCat(buff, #9); + + cin := @buff; + index := 0; + + while (true) do + begin + cend := StrScan(cin, #9); + if (cend = nil) then break; + cend^ := #0; + + case index of + 0: internal := StrPas(cin); + 1: scaps := StrPas(cin); + 2: name := StrPas(cin); + 3: ext := StrPas(cin); + else + begin + comment := StrPas(cin); + if (Length(comment) = 0) or (Length(name) = 0) then break; + + if (comment[1] = '?') then break; + + caps := 0; + for i := 1 to Length(scaps) do + if (scaps[i] <> '-') then caps := caps or (1 shl (i - 1)); + + New(info); + info.Descr := comment; + info.Ext := ext; + info.internal := internal; + info.Capas := caps; + + i := SELF.Add(name); + SELF.PutObject(i, Pointer(info)); + break; + end; + end; + + index := index + 1; + cin := cend + 1; + end; +end; + +function TCapabilities.CanReadAny(Index: Integer): Boolean; +var + caps: Integer; +begin + caps := PFileInfo(SELF.Objects[Index]).Capas; + Result := caps and (1 or 4 or 16) <> 0; +end; + +function TCapabilities.CanWriteAny(Index: Integer): Boolean; +var + caps: Integer; +begin + caps := PFileInfo(SELF.Objects[Index]).Capas; + Result := caps and (2 or 8 or 32) <> 0; +end; + +function TCapabilities.GetCaps(const Descr: string): Integer; +var + info: PFileInfo; + i: Integer; +begin + for i := 0 to Count - 1 do + begin + info := PFileInfo(Objects[i]); + if (AnsiCompareText(info.Descr, Descr) = 0) then + begin + Result := info.Capas; + Exit; + end; + end; + Result := 0; +end; + +function TCapabilities.GetDescr(Index: Integer): string; +var + info: PFileInfo; +begin + info := PFileInfo(Objects[Index]); + Result := info.Descr; +end; + +function TCapabilities.GetExt(const Descr: string): string; +var + i: Integer; + info: PFileInfo; +begin + for i := 0 to Count - 1 do + begin + info := PFileInfo(Objects[i]); + if (AnsiCompareText(info.Descr, Descr) = 0) then + begin + Result := info.Ext; + Exit; + end; + end; + Result := '.*'; +end; + +function TCapabilities.GetList: TStrings; +begin + Result := TStringList.Create; +end; + +function TCapabilities.GetName(const Descr: string): string; +var + i: Integer; + info: PFileInfo; +begin + for i := 0 to Count - 1 do + begin + info := PFileInfo(Objects[i]); + if (AnsiCompareText(info.Descr, Descr) = 0) then + begin + Result := SELF[i]; + Exit; + end; + end; + Result := 'unknown'; +end; + +function TCapabilities.IsDevice(Index: Integer): Boolean; +var + info: PFileInfo; +begin + info := PFileInfo(Objects[Index]); + Result := (AnsiCompareText(info.Internal, 'serial') = 0); +end; + +function TCapabilities.IsFile(Index: Integer): Boolean; +var + info: PFileInfo; +begin + info := PFileInfo(Objects[Index]); + Result := (AnsiCompareText(info.Internal, 'file') = 0); +end; + +procedure TCapabilities.SetList(const Value: TStrings); +var + i: Integer; + s: string; +begin + Clear; + for i := 0 to Value.Count - 1 do + begin + s := Value.Strings[i]; + AddFormat(s); + end; +end; + +initialization + + gpsbabel_exe := SysUtils.ExtractFilePath(ParamStr(0)) + 'gpsbabel.exe'; + +end. diff --git a/win32/gui-2/filter.dfm b/win32/gui-2/filter.dfm new file mode 100644 index 0000000000000000000000000000000000000000..596daab3fd84a479fdec3e653f3b58029d549e21 GIT binary patch literal 7227 zcmd^EU2Gd!6~6Y^9{=RO4XX%tna#GL?XunMrl7PBTN3BDjhk%jQmq!L9nW0Hql{;U znQ=63}d6(J1 zjZitCQfjWJ{0Ws7UEjq1y5TxOX{c^hyFrLs73{Q&b*rN9SuN`=EU2ns*T!nT9xPe9 z?e3^$-3u+($>o@kp|WjZCtSnUPBTTIIxD(?hgMuC zJX>z+et<)DbZL2I;p#^1dUi-zvTuN!LE*YZq@KHcFF)9W~xoMvt~JA zA;0Oc6)JG@TkL*#%i6bq@k(cR1M)N8(O>;}}_X+*94 zO_UY3$Z;cm1!Wg(YsXRZy3MR5jjGNt4*8m1r=Zhml&fv%b!?B?^_tbfTXs9BSWcS@ zX%ZpnSD1`+iHk@N7pR05sHcvE`ZjUSrFIZnjjoiHu6L1OUS!Od^e*G8JfP?$<7vrQ zF3+2K_f&BDlbU2wVocWDw$HgdMFgk`R9+WsTl_Ma1+#xo?8 za>ps9)^L5z!5uB6k&$1tmaK|vVs*G~l1*82sc)oJbFga0#v@z0555!B`6wQc3L$D+ z#;!UZM?{AZ%GQ=mD;&Zm4Wk&=J&N@>kHsIQ1lUP++0pAZHe(`E84}>RV+-Zl`e&E5 zjm=f<1?}V;CtD}Y!z@zuY%7dgWbX)zT%?rD5*nDu)dGAI`?}4IqnX&lj%hhNn(JsL z>|4!kusP2K`p8H#lv8As(KxP>v`Z`Ds96r{b)h?V)L6A?H9}3d1r8}EJ5zCQ;z&$d z+I}o1gPUHhUGi2m;rzKv8u}x{NPXApVu9e=3lU zmES2cb)``RXDoBg*S);(`Tz^+6XlO=CkyG%N$H1pKEphpnng&cGtAUU?8e4ZC^QjM zh%Y880e+E%z-SGTj$Hgng8VrLa$t*(c)n^(4PT zz1@%GDV#lVw1pD+?fnm7q1>Q4+}#P5KTNVbRHL}Z_~NHf>X=Y!Fwa&)-A`ndwIj01 z^EG`J5`|-TW2qw00k+6^`(#++ssz-Hsl_su}7e=V!>mETXS(eRbqB86qI|y-4Os`2o;XvjN44 zALhvzeQ*@bR@rUUU3ezR9h|ugg%Z$)yM(L=503z^J6=1CWp&6CPgaMZV7u&REQEzV ztN%rP2&lvLDIAvbtD);L9iC@FE28F#&|y4Q84WXk^cO~I09+DLQj}355+`3 z&ib3Q$*c#hp1^a7cQ;wxhTcSq9iL%~wV4^MzsX67KIFJvr&Lv|1%_>O%Wm7@PXUis zu+MO3Ju9R=O{bH$p`#78(1qsHXa{BJKz-L%pJ|&+nA`F|7F1eWq|6Lt|8T4i4JnJ+ zX8r}skb`KXx;eosa_Oj%R4yKbM|BaO7M9R_YI;p~Oi?b^yBbvto0`*Z)v-^?Wm+i* z5=LIEkNh2V5Xbuf$snxg!7gberZBTmAh<{yF*AIbnPGxE<&1F3Bx`|Qyy|&?idkP` zqb<>ZHu71PCxQupoO1sB`2tAXz|KzCOe>KJyhBkwH4ELRsKkzPCxiO^B-BX>HCBWl ztu8HHQ?wZWeXJONHG-5LEM*E{Uee$MeE+g^bCw&czh9ibQM4?xt+-SfRSM9FXJPS`sz4)6HLcfA* zu|nR->n2>M;5q@<1Y9YUfp>(Oe4gBo@r&Febcg<1jqdKQ~7SVQg`Fni1Ze zo1=sXotr+x2-%rHkhu-QDM77tYLGpo{1K4ok^m;P>9#93upNl#t+? z$U8qBm9Pv^a%U9T5Q0SwBN2~HB zB*OJs8Lks>n2EKz9zZT_(8JRpN=Pz%)A3OK2L#XG;99JZck&XUD#B5O>K!`E-ozaF zcJbmxbo=&g^x(k*w7>robp86T(aSIY8D%dH}m-^n#UT<~xUh4j>Uhn>`G4#%xz20{^ zB{ByD-}o;5y#LlaFij>pZ<0^oNk4kmLiR~k_W(+C@LAfaU(>tn$rH;y>4Bq9s214C zXJ2hloRRAX4vb6eD2$#X$J!Z^_tsnb4$jec=4oY~#f&)W855o!8``pru)su%was_B3<*O~(i zr)4r2j*SM>hvWf>o}<87&;vjUW4nMo@I^3o`>@UQV+*jS`_N068ma7X5NKf&I}%oI zTQ{xtVR=cB75r4fQXGsd>%_UixZ%bP3S`X1KWD}i70Md|@MM<#2sB~@OFs0paLTy> zi=<_W>+tiD_(5ctd '0d0h0m0s') then + Result := Format('%s,move=%s', [Result, s]); + end; + + if cbTrackPack.Checked then + Result := Format('%s,pack', [Result]) + else if cbTrackMerge.Checked then + Result := Format('%s,merge', [Result]); + + if cbTrackSplit.Checked then + Result := Format('%s,split', [Result]); + + if cbTrackStart.Checked then + Result := Format('%s,start=%s', [ + Result, + FormatDateTime('yyyymmddhhnnss', + Int(dtpTrackStartDate.DateTime) + Frac(dtpTrackStartTime.DateTime))]); + if cbTrackStop.Checked then + Result := Format('%s,stop=%s', [ + Result, + FormatDateTime('yyyymmddhhnnss', + Int(dtpTrackStopDate.DateTime) + Frac(dtpTrackStopTime.DateTime))]); + end; + + if AnyChecked(gbRoutes) then + begin + if cbRouteSimplify.Checked then + Result := Format('%s -x simplify,count=%s', + [Result, Trim(edRoutesSimplifyMaxPoints.Text)]); + + SimpleOption(Result, cbReverse, 'reverse'); + end; +end; + +function TfrmFilter.AnyChecked(Control: TWinControl): Boolean; +var + i: Integer; + c: TWinControl; +begin + Result := False; + for i := 0 to Self.ComponentCount - 1 do + begin + c := Pointer(Self.Components[i]); + if not(c.InheritsFrom(TWinControl)) then Continue; + if (c.parent <> Control) then Continue; + + if ((c is TCheckBox) and TCheckBox(c).Enabled) then + Result := TCheckBox(c).Checked else + if ((c is TGroupBox) and c.Enabled) then + Result := AnyChecked(c); + if (Result) then Exit; + end; +end; + +procedure TfrmFilter.SetTracksEnabled(const Value: Boolean); +begin + FTracksEnabled := Value; + gbTracks.Enabled := Value; +end; + +function TfrmFilter.AllValid: Boolean; +begin + Result := True; +end; + +procedure TfrmFilter.btnOKClick(Sender: TObject); +begin + if AllValid then ModalResult := mrOK; +end; + +procedure TfrmFilter.cbTrackStartClick(Sender: TObject); +begin + dtpTrackStartDate.Enabled := cbTrackStart.Checked; + dtpTrackStartTime.Enabled := cbTrackStart.Checked; +end; + +procedure TfrmFilter.cbTrackStopClick(Sender: TObject); +begin + dtpTrackStopDate.Enabled := cbTrackStop.Checked; + dtpTrackStopTime.Enabled := cbTrackStop.Checked; +end; + +procedure TfrmFilter.cbRouteSimplifyClick(Sender: TObject); +begin + edRoutesSimplifyMaxPoints.Enabled := cbRouteSimplify.Checked; +end; + +procedure TfrmFilter.cbTrackPackClick(Sender: TObject); +begin + if cbTrackPack.Checked then + cbTrackMerge.Checked := False; +end; + +procedure TfrmFilter.cbTrackMergeClick(Sender: TObject); +begin + if cbTrackMerge.Checked then cbTrackPack.Checked := False; +end; + +procedure TfrmFilter.cbWayptMergeDistanceClick(Sender: TObject); +begin + edWayptMergeDist.Enabled := cbWayptMergeDistance.Checked; + cobWayptMergeDist.Enabled := cbWayptMergeDistance.Checked; +end; + +procedure TfrmFilter.cbWayptMergeDupsClick(Sender: TObject); +begin + cbWayptMergeDupLoc.Enabled := cbWayptMergeDups.Checked; + cbWayptMergeDupNames.Enabled := cbWayptMergeDups.Checked; +end; + +end. diff --git a/win32/gui-2/gnugettext.pas b/win32/gui-2/gnugettext.pas new file mode 100644 index 000000000..2ca05de3c --- /dev/null +++ b/win32/gui-2/gnugettext.pas @@ -0,0 +1,2903 @@ +unit gnugettext; +(**************************************************************) +(* *) +(* (C) Copyright by Lars B. Dybdahl and others *) +(* E-mail: Lars@dybdahl.dk, phone +45 70201241 *) +(* File version: $Date: 2005/09/28 00:33:08 $ *) +(* Revision: $Revision: 1.1 $ *) +(* *) +(* Contributors: Peter Thornqvist, Troy Wolbrink, *) +(* Frank Andreas de Groot, Igor Siticov, *) +(* Jacques Garcia Vazquez *) +(* *) +(* See http://dybdahl.dk/dxgettext/ for more information *) +(* *) +(**************************************************************) + +// Redistribution and use in source and binary forms, with or without +// modification, are permitted provided that the following conditions are met: +// +// The names of any contributor may not be used to endorse or promote +// products derived from this software without specific prior written permission. +// +// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +// SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +// CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +// OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +// OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +interface + +// If the conditional define DXGETTEXTDEBUG is defined, debugging log is activated. +// Use DefaultInstance.DebugLogToFile() to write the log to a file. +{ $define DXGETTEXTDEBUG} + +{$ifdef VER100} + // Delphi 3 + {$DEFINE DELPHI5OROLDER} + {$DEFINE DELPHI6OROLDER} +{$endif} +{$ifdef VER110} + // C++ Builder 3 + {$DEFINE DELPHI5OROLDER} + {$DEFINE DELPHI6OROLDER} +{$endif} +{$ifdef VER120} + // Delphi 4 + {$DEFINE DELPHI5OROLDER} + {$DEFINE DELPHI6OROLDER} +{$endif} +{$ifdef VER125} + // C++ Builder 4 + {$DEFINE DELPHI5OROLDER} + {$DEFINE DELPHI6OROLDER} +{$endif} +{$ifdef VER130} + // Delphi 5 + {$DEFINE DELPHI5OROLDER} + {$DEFINE DELPHI6OROLDER} + {$ifdef WIN32} + {$DEFINE MSWINDOWS} + {$endif} +{$endif} +{$ifdef VER135} + // C++ Builder 5 + {$DEFINE DELPHI5OROLDER} + {$DEFINE DELPHI6OROLDER} + {$ifdef WIN32} + {$DEFINE MSWINDOWS} + {$endif} +{$endif} +{$ifdef VER140} + // Delphi 6 +{$ifdef MSWINDOWS} + {$DEFINE DELPHI6OROLDER} +{$endif} +{$endif} +{$ifdef VER150} + // Delphi 7 +{$endif} + +uses +{$ifdef DELPHI5OROLDER} + gnugettextD4, +{$endif} + +{$ifdef MSWINDOWS} + Windows, +{$else} + Libc, +{$endif} + Classes, SysUtils, TypInfo; + +(*****************************************************************************) +(* *) +(* MAIN API *) +(* *) +(*****************************************************************************) + +// Main GNU gettext functions. See documentation for instructions on how to use them. +function _(const szMsgId: widestring): widestring; +function gettext(const szMsgId: widestring): widestring; +function dgettext(const szDomain: string; const szMsgId: widestring): widestring; +function dngettext(const szDomain: string; const singular,plural: widestring; Number:longint): widestring; +function ngettext(const singular,plural: widestring; Number:longint): widestring; +procedure textdomain(const szDomain: string); +function getcurrenttextdomain: string; +procedure bindtextdomain(const szDomain: string; const szDirectory: string); + +// Set language to use +procedure UseLanguage(LanguageCode: string); +function GetCurrentLanguage:string; + +// Translates a component (form, frame etc.) to the currently selected language. +// Put TranslateComponent(self) in the OnCreate event of all your forms. +// See the manual for documentation on these functions +type + TTranslator=procedure (obj:TObject) of object; + +procedure TP_Ignore(AnObject:TObject; const name:string); +procedure TP_IgnoreClass (IgnClass:TClass); +procedure TP_IgnoreClassProperty (IgnClass:TClass;const propertyname:string); +procedure TP_GlobalIgnoreClass (IgnClass:TClass); +procedure TP_GlobalIgnoreClassProperty (IgnClass:TClass;const propertyname:string); +procedure TP_GlobalHandleClass (HClass:TClass;Handler:TTranslator); +procedure TranslateComponent(AnObject: TComponent; const TextDomain:string=''); +procedure RetranslateComponent(AnObject: TComponent; const TextDomain:string=''); + +// Add more domains that resourcestrings can be extracted from. If a translation +// is not found in the default domain, this domain will be searched, too. +// This is useful for adding mo files for certain runtime libraries and 3rd +// party component libraries +procedure AddDomainForResourceString (const domain:string); +procedure RemoveDomainForResourceString (const domain:string); + +// Unicode-enabled way to get resourcestrings, automatically translated +// Use like this: ws:=LoadResStringW(@NameOfResourceString); +function LoadResString(ResStringRec: PResStringRec): widestring; +function LoadResStringA(ResStringRec: PResStringRec): ansistring; +function LoadResStringW(ResStringRec: PResStringRec): widestring; + +// This returns an empty string if not translated or translator name is not specified. +function GetTranslatorNameAndEmail:widestring; + + +(*****************************************************************************) +(* *) +(* ADVANCED FUNCTIONALITY *) +(* *) +(*****************************************************************************) + +const + DefaultTextDomain = 'default'; + +var + ExecutableFilename:string; // This is set to paramstr(0) or the name of the DLL you are creating. + +type + EGnuGettext=class(Exception); + EGGProgrammingError=class(EGnuGettext); + EGGComponentError=class(EGnuGettext); + EGGIOError=class(EGnuGettext); + EGGAnsi2WideConvError=class(EGnuGettext); + +// This function will turn resourcestring hooks on or off, eventually with BPL file support. +// Please do not activate BPL file support when the package is in design mode. +const AutoCreateHooks=true; +procedure HookIntoResourceStrings (enabled:boolean=true; SupportPackages:boolean=false); + + + + +(*****************************************************************************) +(* *) +(* CLASS based implementation. *) +(* Use TGnuGettextInstance to have more than one language *) +(* in your application at the same time *) +(* *) +(*****************************************************************************) + +{$ifdef MSWINDOWS} +{$ifndef DELPHI6OROLDER} +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CODE OFF} +{$WARN UNSAFE_CAST OFF} +{$endif} +{$endif} + +type + TOnDebugLine = Procedure (Sender: TObject; const Line: String; var Discard: Boolean) of Object; // Set Discard to false if output should still go to ordinary debug log + TGetPluralForm=function (Number:Longint):Integer; + TDebugLogger=procedure (line: ansistring) of object; + TMoFile= // Don't use this class. It's for internal use. + class // Threadsafe. Only constructor and destructor are writing to memory + private + doswap: boolean; + public + Users:Integer; // Reference count. If it reaches zero, this object should be destroyed. + constructor Create (filename:string;Offset,Size:int64); + destructor Destroy; override; + function gettext(const msgid: ansistring;var found:boolean): ansistring; // uses mo file + property isSwappedArchitecture:boolean read doswap; + private + N, O, T: Cardinal; // Values defined at http://www.linuxselfhelp.com/gnu/gettext/html_chapter/gettext_6.html + startindex,startstep:integer; + {$ifdef mswindows} + mo: THandle; + momapping: THandle; + {$endif} + momemoryHandle:PChar; + momemory: PChar; + function autoswap32(i: cardinal): cardinal; + function CardinalInMem(baseptr: PChar; Offset: Cardinal): Cardinal; + end; + TDomain= // Don't use this class. It's for internal use. + class + private + Enabled:boolean; + vDirectory: string; + procedure setDirectory(const dir: string); + public + DebugLogger:TDebugLogger; + Domain: string; + property Directory: string read vDirectory write setDirectory; + constructor Create; + destructor Destroy; override; + // Set parameters + procedure SetLanguageCode (const langcode:string); + procedure SetFilename (const filename:string); // Bind this domain to a specific file + // Get information + procedure GetListOfLanguages(list:TStrings); + function GetTranslationProperty(Propertyname: string): WideString; + function gettext(const msgid: ansistring): ansistring; // uses mo file + private + mofile:TMoFile; + SpecificFilename:string; + curlang: string; + OpenHasFailedBefore: boolean; + procedure OpenMoFile; + procedure CloseMoFile; + end; + TExecutable= + class + procedure Execute; virtual; abstract; + end; + TGnuGettextInstance= + class + private + fOnDebugLine:TOnDebugLine; + CreatorThread:Cardinal; // Only this thread can use LoadResString + public + Enabled:Boolean; // Set this to false to disable translations + DesignTimeCodePage:Integer; // See MultiByteToWideChar() in Win32 API for documentation + constructor Create; + destructor Destroy; override; + procedure UseLanguage(LanguageCode: string); + procedure GetListOfLanguages (const domain:string; list:TStrings); // Puts list of language codes, for which there are translations in the specified domain, into list + {$ifdef DELPHI5OROLDER} + function gettext(const szMsgId: widestring): widestring; + function ngettext(const singular,plural:widestring;Number:longint):widestring; + {$endif} + {$ifndef DELPHI5OROLDER} + function gettext(const szMsgId: ansistring): widestring; overload; + function gettext(const szMsgId: widestring): widestring; overload; + function ngettext(const singular,plural:ansistring;Number:longint):widestring; overload; + function ngettext(const singular,plural:widestring;Number:longint):widestring; overload; + {$endif} + function GetCurrentLanguage:string; + function GetTranslationProperty (const Propertyname:string):WideString; + function GetTranslatorNameAndEmail:widestring; + + // Form translation tools, these are not threadsafe. All TP_ procs must be called just before TranslateProperites() + procedure TP_Ignore(AnObject:TObject; const name:string); + procedure TP_IgnoreClass (IgnClass:TClass); + procedure TP_IgnoreClassProperty (IgnClass:TClass;propertyname:string); + procedure TP_GlobalIgnoreClass (IgnClass:TClass); + procedure TP_GlobalIgnoreClassProperty (IgnClass:TClass;propertyname:string); + procedure TP_GlobalHandleClass (HClass:TClass;Handler:TTranslator); + procedure TranslateProperties(AnObject: TObject; textdomain:string=''); + procedure TranslateComponent(AnObject: TComponent; const TextDomain:string=''); + procedure RetranslateComponent(AnObject: TComponent; const TextDomain:string=''); + + // Multi-domain functions + {$ifdef DELPHI5OROLDER} + function dgettext(const szDomain: string; const szMsgId: widestring): widestring; + function dngettext(const szDomain: string; const singular,plural:widestring;Number:longint):widestring; + {$endif} + {$ifndef DELPHI5OROLDER} + function dgettext(const szDomain: string; const szMsgId: ansistring): widestring; overload; + function dgettext(const szDomain: string; const szMsgId: widestring): widestring; overload; + function dngettext(const szDomain: string; const singular,plural:ansistring;Number:longint):widestring; overload; + function dngettext(const szDomain: string; const singular,plural:widestring;Number:longint):widestring; overload; + {$endif} + procedure textdomain(const szDomain: string); + function getcurrenttextdomain: string; + procedure bindtextdomain(const szDomain: string; const szDirectory: string); + procedure bindtextdomainToFile (const szDomain: string; const filename: string); // Also works with files embedded in exe file + + // Windows API functions + function LoadResString(ResStringRec: PResStringRec): widestring; + + // Output all log info to this file. This may only be called once. + procedure DebugLogToFile (const filename:string; append:boolean=false); + procedure DebugLogPause (PauseEnabled:boolean); + property OnDebugLine: TOnDebugLine read fOnDebugLine write fOnDebugLine; // If set, all debug output goes here + + // Conversion according to design-time character set + function ansi2wide (const s:ansistring):widestring; + protected + procedure TranslateStrings (sl:TStrings;const TextDomain:string); + + // Override these three, if you want to inherited from this class + // to create a new class that handles other domain and language dependent + // issues + procedure WhenNewLanguage (const LanguageID:string); virtual; // Override to know when language changes + procedure WhenNewDomain (const TextDomain:string); virtual; // Override to know when text domain changes. Directory is purely informational + procedure WhenNewDomainDirectory (const TextDomain,Directory:string); virtual; // Override to know when any text domain's directory changes. It won't be called if a domain is fixed to a specific file. + private + curlang: string; + curGetPluralForm:TGetPluralForm; + curmsgdomain: string; + savefileCS: TMultiReadExclusiveWriteSynchronizer; + savefile: TextFile; + savememory: TStringList; + DefaultDomainDirectory:string; + domainlist: TStringList; // List of domain names. Objects are TDomain. + TP_IgnoreList:TStringList; // Temporary list, reset each time TranslateProperties is called + TP_ClassHandling:TList; // Items are TClassMode. If a is derived from b, a comes first + TP_GlobalClassHandling:TList; // Items are TClassMode. If a is derived from b, a comes first + TP_Retranslator:TExecutable; // Cast this to TTP_Retranslator + DebugLogCS:TMultiReadExclusiveWriteSynchronizer; + DebugLog:TStream; + DebugLogOutputPaused:Boolean; + function TP_CreateRetranslator:TExecutable; // Must be freed by caller! + procedure FreeTP_ClassHandlingItems; + procedure DebugWriteln(line: ansistring); + procedure TranslateProperty(AnObject: TObject; PropInfo: PPropInfo; + TodoList: TStrings; const TextDomain:string); + function Getdomain(const domain, DefaultDomainDirectory, CurLang: string): TDomain; // Translates a single property of an object + end; + +var + DefaultInstance:TGnuGettextInstance; + +// DELPHI 4 + +function GetStrProp(Instance: TObject; const Name: string): string; overload; +function GetStrProp(Instance: TObject; Info: PPropInfo): string; overload; + +procedure SetStrProp(Instance: TObject; const Name, Value: string); overload; +procedure SetStrProp(Instance: TObject; Info: PPropInfo; const Value: string); overload; + +implementation + +(**************************************************************************) +// Some comments on the implementation: +// This unit should be independent of other units where possible. +// It should have a small footprint in any way. +(**************************************************************************) +// TMultiReadExclusiveWriteSynchronizer is used instead of TCriticalSection +// because it makes this unit independent of the SyncObjs unit +(**************************************************************************) + +{$ifdef DELPHI5OROLDER} +uses + FileCtrl; +{$endif} + +type + TTP_RetranslatorItem= + class + obj:TObject; + Propname:string; + OldValue:WideString; + end; + TTP_Retranslator= + class (TExecutable) + TextDomain:string; + Instance:TGnuGettextInstance; + constructor Create; + destructor Destroy; override; + procedure Remember (obj:TObject; PropName:String; OldValue:WideString); + procedure Execute; override; + private + list:TList; + end; + TEmbeddedFileInfo= + class + offset,size:int64; + end; + TFileLocator= + class // This class finds files even when embedded inside executable + constructor Create; + destructor Destroy; override; + procedure Analyze; // List files embedded inside executable + function FileExists (filename:string):boolean; + function GetMoFile (filename:string;DebugLogger:TDebugLogger):TMoFile; + procedure ReleaseMoFile (mofile:TMoFile); + private + basedirectory:string; + filelist:TStringList; //Objects are TEmbeddedFileInfo. Filenames are relative to .exe file + MoFilesCS:TMultiReadExclusiveWriteSynchronizer; + MoFiles:TStringList; // Objects are filenames+offset, objects are TMoFile + function ReadInt64 (str:TStream):int64; + end; + TGnuGettextComponentMarker= + class (TComponent) + public + LastLanguage:string; + Retranslator:TExecutable; + destructor Destroy; override; + end; + TClassMode= + class + HClass:TClass; + SpecialHandler:TTranslator; + PropertiesToIgnore:TStringList; // This is ignored if Handler is set + constructor Create; + destructor Destroy; override; + end; + TRStrinfo = record + strlength, stroffset: cardinal; + end; + TStrInfoArr = array[0..10000000] of TRStrinfo; + PStrInfoArr = ^TStrInfoArr; + TCharArray5=array[0..4] of ansichar; + THook= // Replaces a runtime library procedure with a custom procedure + class + public + constructor Create (OldProcedure, NewProcedure: pointer; FollowJump:boolean=false); + destructor Destroy; override; // Restores unhooked state + procedure Reset (FollowJump:boolean=false); // Disables and picks up patch points again + procedure Disable; + procedure Enable; + private + oldproc,newproc:Pointer; + Patch:TCharArray5; + Original:TCharArray5; + PatchPosition:PChar; + procedure Shutdown; // Same as destroy, except that object is not destroyed + end; + +var + // System information + Win32PlatformIsUnicode:boolean=False; + + // Information about files embedded inside .exe file + FileLocator:TFileLocator; + + // Hooks into runtime library functions + ResourceStringDomainListCS:TMultiReadExclusiveWriteSynchronizer; + ResourceStringDomainList:TStringList; + HookLoadResString:THook; + HookLoadStr:THook; + HookFmtLoadStr:THook; + +function GGGetEnvironmentVariable(const Name:string):string; +var + Len: integer; + W : String; +begin + Result := ''; + SetLength(W,1); + Len := Windows.GetEnvironmentVariable(PChar(Name), PChar(W), 1); + if Len > 0 then begin + SetLength(Result, Len - 1); + Windows.GetEnvironmentVariable(PChar(Name), PChar(Result), Len); + end; +end; + +function StripCR (s:string):string; +var + i:integer; +begin + i:=1; + while i<=length(s) do begin + if s[i]=#13 then delete (s,i,1) else inc (i); + end; + Result:=s; +end; + +function LF2LineBreakA (s:string):string; +{$ifdef MSWINDOWS} +var + i:integer; +{$endif} +begin + {$ifdef MSWINDOWS} + Assert (sLinebreak=#13#10); + i:=1; + while i<=length(s) do begin + if (s[i]=#10) and (copy(s,i-1,1)<>#13) then begin + insert (#13,s,i); + inc (i,2); + end else + inc (i); + end; + {$endif} + Result:=s; +end; + +function IsWriteProp(Info: PPropInfo): Boolean; +begin + Result := Assigned(Info) and (Info^.SetProc <> nil); +end; + +function string2csyntax(s: string): string; +// Converts a string to the syntax that is used in .po files +var + i: integer; + c: char; +begin + Result := ''; + for i := 1 to length(s) do begin + c := s[i]; + case c of + #32..#33, #35..#255: Result := Result + c; + #13: Result := Result + '\r'; + #10: Result := Result + '\n"'#13#10'"'; + #34: Result := Result + '\"'; + else + Result := Result + '\0x' + IntToHex(ord(c), 2); + end; + end; + Result := '"' + Result + '"'; +end; + +function ResourceStringGettext(MsgId: widestring): widestring; +var + i:integer; +begin + if (MsgID='') or (ResourceStringDomainListCS=nil) then begin + // This only happens during very complicated program startups that fail, + // or when Msgid='' + Result:=MsgId; + exit; + end; + ResourceStringDomainListCS.BeginRead; + try + for i:=0 to ResourceStringDomainList.Count-1 do begin + Result:=dgettext(ResourceStringDomainList.Strings[i], MsgId); + if Result<>MsgId then + break; + end; + finally + ResourceStringDomainListCS.EndRead; + end; +end; + +function gettext(const szMsgId: widestring): widestring; +begin + Result:=DefaultInstance.gettext(szMsgId); +end; + +function _(const szMsgId: widestring): widestring; +begin + Result:=DefaultInstance.gettext(szMsgId); +end; + +function dgettext(const szDomain: string; const szMsgId: widestring): widestring; +begin + Result:=DefaultInstance.dgettext(szDomain, szMsgId); +end; + +function dngettext(const szDomain: string; const singular,plural: widestring; Number:longint): widestring; +begin + Result:=DefaultInstance.dngettext(szDomain,singular,plural,Number); +end; + +function ngettext(const singular,plural: widestring; Number:longint): widestring; +begin + Result:=DefaultInstance.ngettext(singular,plural,Number); +end; + +procedure textdomain(const szDomain: string); +begin + DefaultInstance.textdomain(szDomain); +end; + +procedure SetGettextEnabled (enabled:boolean); +begin + DefaultInstance.Enabled:=enabled; +end; + +function getcurrenttextdomain: string; +begin + Result:=DefaultInstance.getcurrenttextdomain; +end; + +procedure bindtextdomain(const szDomain: string; const szDirectory: string); +begin + DefaultInstance.bindtextdomain(szDomain, szDirectory); +end; + +procedure TP_Ignore(AnObject:TObject; const name:string); +begin + DefaultInstance.TP_Ignore(AnObject, name); +end; + +procedure TP_GlobalIgnoreClass (IgnClass:TClass); +begin + DefaultInstance.TP_GlobalIgnoreClass(IgnClass); +end; + +procedure TP_IgnoreClass (IgnClass:TClass); +begin + DefaultInstance.TP_IgnoreClass(IgnClass); +end; + +procedure TP_IgnoreClassProperty (IgnClass:TClass;const propertyname:string); +begin + DefaultInstance.TP_IgnoreClassProperty(IgnClass,propertyname); +end; + +procedure TP_GlobalIgnoreClassProperty (IgnClass:TClass;const propertyname:string); +begin + DefaultInstance.TP_GlobalIgnoreClassProperty(IgnClass,propertyname); +end; + +procedure TP_GlobalHandleClass (HClass:TClass;Handler:TTranslator); +begin + DefaultInstance.TP_GlobalHandleClass (HClass, Handler); +end; + +procedure TranslateComponent(AnObject: TComponent; const TextDomain:string=''); +begin + DefaultInstance.TranslateComponent(AnObject, TextDomain); +end; + +procedure RetranslateComponent(AnObject: TComponent; const TextDomain:string=''); +begin + DefaultInstance.RetranslateComponent(AnObject, TextDomain); +end; + +{$ifdef MSWINDOWS} + +// These constants are only used in Windows 95 +// Thanks to Frank Andreas de Groot for this table +const + IDAfrikaans = $0436; IDAlbanian = $041C; + IDArabicAlgeria = $1401; IDArabicBahrain = $3C01; + IDArabicEgypt = $0C01; IDArabicIraq = $0801; + IDArabicJordan = $2C01; IDArabicKuwait = $3401; + IDArabicLebanon = $3001; IDArabicLibya = $1001; + IDArabicMorocco = $1801; IDArabicOman = $2001; + IDArabicQatar = $4001; IDArabic = $0401; + IDArabicSyria = $2801; IDArabicTunisia = $1C01; + IDArabicUAE = $3801; IDArabicYemen = $2401; + IDArmenian = $042B; IDAssamese = $044D; + IDAzeriCyrillic = $082C; IDAzeriLatin = $042C; + IDBasque = $042D; IDByelorussian = $0423; + IDBengali = $0445; IDBulgarian = $0402; + IDBurmese = $0455; IDCatalan = $0403; + IDChineseHongKong = $0C04; IDChineseMacao = $1404; + IDSimplifiedChinese = $0804; IDChineseSingapore = $1004; + IDTraditionalChinese = $0404; IDCroatian = $041A; + IDCzech = $0405; IDDanish = $0406; + IDBelgianDutch = $0813; IDDutch = $0413; + IDEnglishAUS = $0C09; IDEnglishBelize = $2809; + IDEnglishCanadian = $1009; IDEnglishCaribbean = $2409; + IDEnglishIreland = $1809; IDEnglishJamaica = $2009; + IDEnglishNewZealand = $1409; IDEnglishPhilippines = $3409; + IDEnglishSouthAfrica = $1C09; IDEnglishTrinidad = $2C09; + IDEnglishUK = $0809; IDEnglishUS = $0409; + IDEnglishZimbabwe = $3009; IDEstonian = $0425; + IDFaeroese = $0438; IDFarsi = $0429; + IDFinnish = $040B; IDBelgianFrench = $080C; + IDFrenchCameroon = $2C0C; IDFrenchCanadian = $0C0C; + IDFrenchCotedIvoire = $300C; IDFrench = $040C; + IDFrenchLuxembourg = $140C; IDFrenchMali = $340C; + IDFrenchMonaco = $180C; IDFrenchReunion = $200C; + IDFrenchSenegal = $280C; IDSwissFrench = $100C; + IDFrenchWestIndies = $1C0C; IDFrenchZaire = $240C; + IDFrisianNetherlands = $0462; IDGaelicIreland = $083C; + IDGaelicScotland = $043C; IDGalician = $0456; + IDGeorgian = $0437; IDGermanAustria = $0C07; + IDGerman = $0407; IDGermanLiechtenstein = $1407; + IDGermanLuxembourg = $1007; IDSwissGerman = $0807; + IDGreek = $0408; IDGujarati = $0447; + IDHebrew = $040D; IDHindi = $0439; + IDHungarian = $040E; IDIcelandic = $040F; + IDIndonesian = $0421; IDItalian = $0410; + IDSwissItalian = $0810; IDJapanese = $0411; + IDKannada = $044B; IDKashmiri = $0460; + IDKazakh = $043F; IDKhmer = $0453; + IDKirghiz = $0440; IDKonkani = $0457; + IDKorean = $0412; IDLao = $0454; + IDLatvian = $0426; IDLithuanian = $0427; + IDMacedonian = $042F; IDMalaysian = $043E; + IDMalayBruneiDarussalam = $083E; IDMalayalam = $044C; + IDMaltese = $043A; IDManipuri = $0458; + IDMarathi = $044E; IDMongolian = $0450; + IDNepali = $0461; IDNorwegianBokmol = $0414; + IDNorwegianNynorsk = $0814; IDOriya = $0448; + IDPolish = $0415; IDBrazilianPortuguese = $0416; + IDPortuguese = $0816; IDPunjabi = $0446; + IDRhaetoRomanic = $0417; IDRomanianMoldova = $0818; + IDRomanian = $0418; IDRussianMoldova = $0819; + IDRussian = $0419; IDSamiLappish = $043B; + IDSanskrit = $044F; IDSerbianCyrillic = $0C1A; + IDSerbianLatin = $081A; IDSesotho = $0430; + IDSindhi = $0459; IDSlovak = $041B; + IDSlovenian = $0424; IDSorbian = $042E; + IDSpanishArgentina = $2C0A; IDSpanishBolivia = $400A; + IDSpanishChile = $340A; IDSpanishColombia = $240A; + IDSpanishCostaRica = $140A; IDSpanishDominicanRepublic = $1C0A; + IDSpanishEcuador = $300A; IDSpanishElSalvador = $440A; + IDSpanishGuatemala = $100A; IDSpanishHonduras = $480A; + IDMexicanSpanish = $080A; IDSpanishNicaragua = $4C0A; + IDSpanishPanama = $180A; IDSpanishParaguay = $3C0A; + IDSpanishPeru = $280A; IDSpanishPuertoRico = $500A; + IDSpanishModernSort = $0C0A; IDSpanish = $040A; + IDSpanishUruguay = $380A; IDSpanishVenezuela = $200A; + IDSutu = $0430; IDSwahili = $0441; + IDSwedishFinland = $081D; IDSwedish = $041D; + IDTajik = $0428; IDTamil = $0449; + IDTatar = $0444; IDTelugu = $044A; + IDThai = $041E; IDTibetan = $0451; + IDTsonga = $0431; IDTswana = $0432; + IDTurkish = $041F; IDTurkmen = $0442; + IDUkrainian = $0422; IDUrdu = $0420; + IDUzbekCyrillic = $0843; IDUzbekLatin = $0443; + IDVenda = $0433; IDVietnamese = $042A; + IDWelsh = $0452; IDXhosa = $0434; + IDZulu = $0435; + +function GetWindowsLanguage: string; +var + langid: Cardinal; + langcode: string; + CountryName: array[0..4] of char; + LanguageName: array[0..4] of char; + works: boolean; +begin + // The return value of GetLocaleInfo is compared with 3 = 2 characters and a zero + works := 3 = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SISO639LANGNAME, LanguageName, SizeOf(LanguageName)); + works := works and (3 = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SISO3166CTRYNAME, CountryName, + SizeOf(CountryName))); + if works then begin + // Windows 98, Me, NT4, 2000, XP and newer + LangCode := PChar(@LanguageName[0]); + if lowercase(LangCode)='no' then LangCode:='nb'; + LangCode:=LangCode + '_' + PChar(@CountryName[0]); + end else begin + // This part should only happen on Windows 95. + langid := GetThreadLocale; + case langid of + IDBelgianDutch: langcode := 'nl_BE'; + IDBelgianFrench: langcode := 'fr_BE'; + IDBrazilianPortuguese: langcode := 'pt_BR'; + IDDanish: langcode := 'da_DK'; + IDDutch: langcode := 'nl_NL'; + IDEnglishUK: langcode := 'en_GB'; + IDEnglishUS: langcode := 'en_US'; + IDFinnish: langcode := 'fi_FI'; + IDFrench: langcode := 'fr_FR'; + IDFrenchCanadian: langcode := 'fr_CA'; + IDGerman: langcode := 'de_DE'; + IDGermanLuxembourg: langcode := 'de_LU'; + IDGreek: langcode := 'el_GR'; + IDIcelandic: langcode := 'is_IS'; + IDItalian: langcode := 'it_IT'; + IDKorean: langcode := 'ko_KO'; + IDNorwegianBokmol: langcode := 'nb_NO'; + IDNorwegianNynorsk: langcode := 'nn_NO'; + IDPolish: langcode := 'pl_PL'; + IDPortuguese: langcode := 'pt_PT'; + IDRussian: langcode := 'ru_RU'; + IDSpanish, IDSpanishModernSort: langcode := 'es_ES'; + IDSwedish: langcode := 'sv_SE'; + IDSwedishFinland: langcode := 'sv_FI'; + else + langcode := 'C'; + end; + end; + Result := langcode; +end; +{$endif} + +function LoadResStringA(ResStringRec: PResStringRec): string; +begin + Result:=DefaultInstance.LoadResString(ResStringRec); +end; + +function GetTranslatorNameAndEmail:widestring; +begin + Result:=DefaultInstance.GetTranslatorNameAndEmail; +end; + +procedure UseLanguage(LanguageCode: string); +begin + DefaultInstance.UseLanguage(LanguageCode); +end; + +type + PStrData = ^TStrData; + TStrData = record + Ident: Integer; + Str: string; + end; + +function SysUtilsEnumStringModules(Instance: Longint; Data: Pointer): Boolean; +{$IFDEF MSWINDOWS} +var + Buffer: array [0..1023] of char; +begin + with PStrData(Data)^ do begin + SetString(Str, Buffer, + LoadString(Instance, Ident, Buffer, sizeof(Buffer))); + Result := Str = ''; + end; +end; +{$ENDIF} +{$IFDEF LINUX} +var + rs:TResStringRec; + Module:HModule; +begin + Module:=Instance; + rs.Module:=@Module; + with PStrData(Data)^ do begin + rs.Identifier:=Ident; + Str:=System.LoadResString(@rs); + Result:=Str=''; + end; +end; +{$ENDIF} + +function SysUtilsFindStringResource(Ident: Integer): string; +var + StrData: TStrData; +begin + StrData.Ident := Ident; + StrData.Str := ''; + EnumResourceModules(SysUtilsEnumStringModules, @StrData); + Result := StrData.Str; +end; + +function SysUtilsLoadStr(Ident: Integer): string; +begin + {$ifdef DXGETTEXTDEBUG} + DefaultInstance.DebugWriteln ('Sysutils.LoadRes('+IntToStr(ident)+') called'); + {$endif} + Result := ResourceStringGettext(SysUtilsFindStringResource(Ident)); +end; + +function SysUtilsFmtLoadStr(Ident: Integer; const Args: array of const): string; +begin + {$ifdef DXGETTEXTDEBUG} + DefaultInstance.DebugWriteln ('Sysutils.FmtLoadRes('+IntToStr(ident)+',Args) called'); + {$endif} + FmtStr(Result, SysUtilsFindStringResource(Ident), Args); + Result:=ResourceStringGettext(Result); +end; + +function LoadResString(ResStringRec: PResStringRec): widestring; +begin + Result:=DefaultInstance.LoadResString(ResStringRec); +end; + +function LoadResStringW(ResStringRec: PResStringRec): widestring; +begin + Result:=DefaultInstance.LoadResString(ResStringRec); +end; + + + +function GetCurrentLanguage:string; +begin + Result:=DefaultInstance.GetCurrentLanguage; +end; + +{ TDomain } + +procedure TDomain.CloseMoFile; +begin + if mofile<>nil then begin + FileLocator.ReleaseMoFile(mofile); + mofile:=nil; + end; + OpenHasFailedBefore:=False; +end; + +destructor TDomain.Destroy; +begin + CloseMoFile; + inherited; +end; + +{$ifdef mswindows} +function GetLastWinError:string; +var + errcode:Cardinal; +begin + SetLength (Result,2000); + errcode:=GetLastError(); + Windows.FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,errcode,0,PChar(Result),2000,nil); + Result:=StrPas(PChar(Result)); +end; +{$endif} + +procedure TDomain.OpenMoFile; +var + filename: string; +begin + // Check if it is already open + if mofile<>nil then + exit; + + // Check if it has been attempted to open the file before + if OpenHasFailedBefore then + exit; + + if SpecificFilename<>'' then + filename:=SpecificFilename + else begin + filename := Directory + curlang + PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo'; + if (not FileLocator.FileExists(filename)) and (not fileexists(filename)) then + filename := Directory + copy(curlang, 1, 2) + PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo'; + end; + if (not FileLocator.FileExists(filename)) and (not fileexists(filename)) then begin + OpenHasFailedBefore:=True; + exit; + end; + mofile:=FileLocator.GetMoFile(filename, DebugLogger); + + {$ifdef DXGETTEXTDEBUG} + if mofile.isSwappedArchitecture then + DebugLogger ('.mo file is swapped (comes from another CPU architecture)'); + {$endif} + + // Check, that the contents of the file is utf-8 + if pos('CHARSET=UTF-8',uppercase(GetTranslationProperty('Content-Type')))=0 then begin + CloseMoFile; + {$ifdef DXGETTEXTDEBUG} + DebugLogger ('The translation for the language code '+curlang+' (in '+filename+') does not have charset=utf-8 in its Content-Type. Translations are turned off.'); + {$endif} + {$ifdef MSWINDOWS} + MessageBox(0,PChar('The translation for the language code '+curlang+' (in '+filename+') does not have charset=utf-8 in its Content-Type. Translations are turned off.'),'Localization problem',MB_OK); + {$else} + writeln (stderr,'The translation for the language code '+curlang+' (in '+filename+') does not have charset=utf-8 in its Content-Type. Translations are turned off.'); + {$endif} + Enabled:=False; + end; +end; + +function TDomain.GetTranslationProperty( + Propertyname: string): WideString; +var + sl:TStringList; + i:integer; + s:string; +begin + Propertyname:=uppercase(Propertyname)+': '; + sl:=TStringList.Create; + try + sl.Text:=utf8encode(gettext('')); + for i:=0 to sl.Count-1 do begin + s:=sl.Strings[i]; + if uppercase(copy(s,1,length(Propertyname)))=Propertyname then begin + Result:=utf8decode(trim(copy(s,length(PropertyName)+1,maxint))); + {$ifdef DXGETTEXTDEBUG} + DebugLogger ('GetTranslationProperty('+PropertyName+') returns '''+Result+'''.'); + {$endif} + exit; + end; + end; + finally + FreeAndNil (sl); + end; + Result:=''; + {$ifdef DXGETTEXTDEBUG} + DebugLogger ('GetTranslationProperty('+PropertyName+') did not find any value. An empty string is returned.'); + {$endif} +end; + +procedure TDomain.setDirectory(const dir: string); +begin + vDirectory := IncludeTrailingPathDelimiter(dir); + SpecificFilename:=''; + CloseMoFile; +end; + +procedure AddDomainForResourceString (const domain:string); +begin + {$ifdef DXGETTEXTDEBUG} + DefaultInstance.DebugWriteln ('Extra domain for resourcestring: '+domain); + {$endif} + ResourceStringDomainListCS.BeginWrite; + try + if ResourceStringDomainList.IndexOf(domain)=-1 then + ResourceStringDomainList.Add (domain); + finally + ResourceStringDomainListCS.EndWrite; + end; +end; + +procedure RemoveDomainForResourceString (const domain:string); +var + i:integer; +begin + {$ifdef DXGETTEXTDEBUG} + DefaultInstance.DebugWriteln ('Remove domain for resourcestring: '+domain); + {$endif} + ResourceStringDomainListCS.BeginWrite; + try + i:=ResourceStringDomainList.IndexOf(domain); + if i<>-1 then + ResourceStringDomainList.Delete (i); + finally + ResourceStringDomainListCS.EndWrite; + end; +end; + +procedure TDomain.SetLanguageCode(const langcode: string); +begin + CloseMoFile; + curlang:=langcode; +end; + +function GetPluralForm2EN(Number: Integer): Integer; +begin + Number:=abs(Number); + if Number=1 then Result:=0 else Result:=1; +end; + +function GetPluralForm1(Number: Integer): Integer; +begin + Result:=0; +end; + +function GetPluralForm2FR(Number: Integer): Integer; +begin + Number:=abs(Number); + if (Number=1) or (Number=0) then Result:=0 else Result:=1; +end; + +function GetPluralForm3LV(Number: Integer): Integer; +begin + Number:=abs(Number); + if (Number mod 10=1) and (Number mod 100<>11) then + Result:=0 + else + if Number<>0 then Result:=1 + else Result:=2; +end; + +function GetPluralForm3GA(Number: Integer): Integer; +begin + Number:=abs(Number); + if Number=1 then Result:=0 + else if Number=2 then Result:=1 + else Result:=2; +end; + +function GetPluralForm3LT(Number: Integer): Integer; +var + n1,n2:byte; +begin + Number:=abs(Number); + n1:=Number mod 10; + n2:=Number mod 100; + if (n1=1) and (n2<>11) then + Result:=0 + else + if (n1>=2) and ((n2<10) or (n2>=20)) then Result:=1 + else Result:=2; +end; + +function GetPluralForm3PL(Number: Integer): Integer; +var + n1,n2:byte; +begin + Number:=abs(Number); + n1:=Number mod 10; + n2:=Number mod 100; + if n1=1 then Result:=0 + else if (n1>=2) and (n1<=4) and ((n2<10) or (n2>=20)) then Result:=1 + else Result:=2; +end; + +function GetPluralForm3RU(Number: Integer): Integer; +var + n1,n2:byte; +begin + Number:=abs(Number); + n1:=Number mod 10; + n2:=Number mod 100; + if (n1=1) and (n2<>11) then + Result:=0 + else + if (n1>=2) and (n1<=4) and ((n2<10) or (n2>=20)) then Result:=1 + else Result:=2; +end; + +function GetPluralForm4SL(Number: Integer): Integer; +var + n2:byte; +begin + Number:=abs(Number); + n2:=Number mod 100; + if n2=1 then Result:=0 + else + if n2=2 then Result:=1 + else + if (n2=3) or (n2=4) then Result:=2 + else + Result:=3; +end; + +procedure TDomain.GetListOfLanguages(list: TStrings); +var + sr:TSearchRec; + more:boolean; + filename, path, langcode:string; + i, j:integer; +begin + list.Clear; + + // Iterate through filesystem + more:=FindFirst (Directory+'*',faAnyFile,sr)=0; + while more do begin + if (sr.Attr and faDirectory<>0) and (sr.name<>'.') and (sr.name<>'..') then begin + filename := Directory + sr.Name + PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo'; + if fileexists(filename) then begin + langcode:=lowercase(sr.name); + if list.IndexOf(langcode)=-1 then + list.Add(langcode); + end; + end; + more:=FindNext (sr)=0; + end; + + // Iterate through embedded files + for i:=0 to FileLocator.filelist.Count-1 do begin + filename:=FileLocator.basedirectory+FileLocator.filelist.Strings[i]; + path:=Directory; + {$ifdef MSWINDOWS} + path:=uppercase(path); + filename:=uppercase(filename); + {$endif} + j:=length(path); + if copy(filename,1,j)=path then begin + path:=PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo'; + {$ifdef MSWINDOWS} + path:=uppercase(path); + {$endif} + if copy(filename,length(filename)-length(path)+1,length(path))=path then begin + langcode:=lowercase(copy(filename,j+1,length(filename)-length(path)-j)); + if list.IndexOf(langcode)=-1 then + list.Add(langcode); + end; + end; + end; +end; + +procedure TDomain.SetFilename(const filename: string); +begin + CloseMoFile; + vDirectory := ''; + SpecificFilename:=filename; +end; + +function TDomain.gettext(const msgid: ansistring): ansistring; +var + found:boolean; +begin + if not Enabled then begin + Result:=msgid; + exit; + end; + if (mofile=nil) and (not OpenHasFailedBefore) then + OpenMoFile; + if mofile=nil then begin + {$ifdef DXGETTEXTDEBUG} + DebugLogger('.mo file is not open. Not translating "'+msgid+'"'); + {$endif} + Result := msgid; + end else begin + Result:=mofile.gettext(msgid,found); + {$ifdef DXGETTEXTDEBUG} + if found then + DebugLogger ('Found in .mo ('+Domain+'): "'+utf8encode(msgid)+'"->"'+utf8encode(Result)+'"') + else + DebugLogger ('Translation not found in .mo file ('+Domain+') : "'+utf8encode(msgid)+'"'); + {$endif} + end; +end; + +constructor TDomain.Create; +begin + inherited Create; + Enabled:=True; +end; + +{ TGnuGettextInstance } + +procedure TGnuGettextInstance.bindtextdomain(const szDomain, + szDirectory: string); +var + dir:string; +begin + dir:=IncludeTrailingPathDelimiter(szDirectory); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Text domain "'+szDomain+'" is now located at "'+dir+'"'); + {$endif} + getdomain(szDomain,DefaultDomainDirectory,CurLang).Directory := dir; + WhenNewDomainDirectory (szDomain, szDirectory); +end; + +constructor TGnuGettextInstance.Create; +begin + CreatorThread:=GetCurrentThreadId; + {$ifdef MSWindows} + DesignTimeCodePage:=CP_ACP; + {$endif} + {$ifdef DXGETTEXTDEBUG} + DebugLogCS:=TMultiReadExclusiveWriteSynchronizer.Create; + DebugLog:=TMemoryStream.Create; + DebugWriteln('Debug log started '+DateTimeToStr(Now)); + DebugWriteln(''); + {$endif} + curGetPluralForm:=GetPluralForm2EN; + Enabled:=True; + curmsgdomain:=DefaultTextDomain; + savefileCS := TMultiReadExclusiveWriteSynchronizer.Create; + domainlist := TStringList.Create; + TP_IgnoreList:=TStringList.Create; + TP_IgnoreList.Sorted:=True; + TP_GlobalClassHandling:=TList.Create; + TP_ClassHandling:=TList.Create; + + // Set some settings + DefaultDomainDirectory := IncludeTrailingPathDelimiter(extractfilepath(ExecutableFilename))+'locale'; + + UseLanguage(''); + + bindtextdomain(DefaultTextDomain, DefaultDomainDirectory); + textdomain(DefaultTextDomain); + + // Add default properties to ignore + TP_GlobalIgnoreClassProperty(TComponent,'Name'); + TP_GlobalIgnoreClassProperty(TCollection,'PropName'); +end; + +destructor TGnuGettextInstance.Destroy; +begin + if savememory <> nil then begin + savefileCS.BeginWrite; + try + CloseFile(savefile); + finally + savefileCS.EndWrite; + end; + FreeAndNil(savememory); + end; + FreeAndNil (savefileCS); + FreeAndNil (TP_IgnoreList); + while TP_GlobalClassHandling.Count<>0 do begin + TObject(TP_GlobalClassHandling.Items[0]).Free; + TP_GlobalClassHandling.Delete(0); + end; + FreeAndNil (TP_GlobalClassHandling); + FreeTP_ClassHandlingItems; + FreeAndNil (TP_ClassHandling); + while domainlist.Count <> 0 do begin + domainlist.Objects[0].Free; + domainlist.Delete(0); + end; + FreeAndNil(domainlist); + {$ifdef DXGETTEXTDEBUG} + FreeAndNil (DebugLog); + FreeAndNil (DebugLogCS); + {$endif} + inherited; +end; + +{$ifndef DELPHI5OROLDER} +function TGnuGettextInstance.dgettext(const szDomain: string; const szMsgId: ansistring): widestring; +begin + Result:=dgettext(szDomain, ansi2wide(szMsgId)); +end; +{$endif} + +function TGnuGettextInstance.dgettext(const szDomain: string; + const szMsgId: widestring): widestring; +begin + if not Enabled then begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Translation has been disabled. Text is not being translated: '+szMsgid); + {$endif} + Result:=szMsgId; + end else begin + Result:=UTF8Decode(LF2LineBreakA(getdomain(szDomain,DefaultDomainDirectory,CurLang).gettext(StripCR(utf8encode(szMsgId))))); + {$ifdef DXGETTEXTDEBUG} + if (szMsgId<>'') and (Result='') then + DebugWriteln (Format('Error: Translation of %s was an empty string. This may never occur.',[szMsgId])); + {$endif} + end; +end; + +function TGnuGettextInstance.GetCurrentLanguage: string; +begin + Result:=curlang; +end; + +function TGnuGettextInstance.getcurrenttextdomain: string; +begin + Result := curmsgdomain; +end; + +{$ifndef DELPHI5OROLDER} +function TGnuGettextInstance.gettext( + const szMsgId: ansistring): widestring; +begin + Result := dgettext(curmsgdomain, szMsgId); +end; +{$endif} + +function TGnuGettextInstance.gettext( + const szMsgId: widestring): widestring; +begin + Result := dgettext(curmsgdomain, szMsgId); +end; + +procedure TGnuGettextInstance.textdomain(const szDomain: string); +begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Changed text domain to "'+szDomain+'"'); + {$endif} + curmsgdomain := szDomain; + WhenNewDomain (szDomain); +end; + +function TGnuGettextInstance.TP_CreateRetranslator : TExecutable; +var + ttpr:TTP_Retranslator; +begin + ttpr:=TTP_Retranslator.Create; + ttpr.Instance:=self; + TP_Retranslator:=ttpr; + Result:=ttpr; + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('A retranslator was created.'); + {$endif} +end; + +procedure TGnuGettextInstance.TP_GlobalHandleClass(HClass: TClass; + Handler: TTranslator); +var + cm:TClassMode; + i:integer; +begin + for i:=0 to TP_GlobalClassHandling.Count-1 do begin + cm:=TObject(TP_GlobalClassHandling.Items[i]) as TClassMode; + if cm.HClass=HClass then + raise EGGProgrammingError.Create ('You cannot set a handler for a class that has already been assigned otherwise.'); + if HClass.InheritsFrom(cm.HClass) then begin + // This is the place to insert this class + cm:=TClassMode.Create; + cm.HClass:=HClass; + cm.SpecialHandler:=Handler; + TP_GlobalClassHandling.Insert(i,cm); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('A handler was set for class '+HClass.ClassName+'.'); + {$endif} + exit; + end; + end; + cm:=TClassMode.Create; + cm.HClass:=HClass; + cm.SpecialHandler:=Handler; + TP_GlobalClassHandling.Add(cm); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('A handler was set for class '+HClass.ClassName+'.'); + {$endif} +end; + +procedure TGnuGettextInstance.TP_GlobalIgnoreClass(IgnClass: TClass); +var + cm:TClassMode; + i:integer; +begin + for i:=0 to TP_GlobalClassHandling.Count-1 do begin + cm:=TObject(TP_GlobalClassHandling.Items[i]) as TClassMode; + if cm.HClass=IgnClass then + raise EGGProgrammingError.Create ('You cannot add a class to the ignore list that is already on that list: '+IgnClass.ClassName+'. You should keep all TP_Global functions in one place in your source code.'); + if IgnClass.InheritsFrom(cm.HClass) then begin + // This is the place to insert this class + cm:=TClassMode.Create; + cm.HClass:=IgnClass; + TP_GlobalClassHandling.Insert(i,cm); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Globally, class '+IgnClass.ClassName+' is being ignored.'); + {$endif} + exit; + end; + end; + cm:=TClassMode.Create; + cm.HClass:=IgnClass; + TP_GlobalClassHandling.Add(cm); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Globally, class '+IgnClass.ClassName+' is being ignored.'); + {$endif} +end; + +procedure TGnuGettextInstance.TP_GlobalIgnoreClassProperty( + IgnClass: TClass; propertyname: string); +var + cm:TClassMode; + i,idx:integer; +begin + propertyname:=uppercase(propertyname); + for i:=0 to TP_GlobalClassHandling.Count-1 do begin + cm:=TObject(TP_GlobalClassHandling.Items[i]) as TClassMode; + if cm.HClass=IgnClass then begin + if Assigned(cm.SpecialHandler) then + raise EGGProgrammingError.Create ('You cannot ignore a class property for a class that has a handler set.'); + if not cm.PropertiesToIgnore.Find(propertyname,idx) then + cm.PropertiesToIgnore.Add(propertyname); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Globally, the '+propertyname+' property of class '+IgnClass.ClassName+' is being ignored.'); + {$endif} + exit; + end; + if IgnClass.InheritsFrom(cm.HClass) then begin + // This is the place to insert this class + cm:=TClassMode.Create; + cm.HClass:=IgnClass; + cm.PropertiesToIgnore.Add(propertyname); + TP_GlobalClassHandling.Insert(i,cm); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Globally, the '+propertyname+' property of class '+IgnClass.ClassName+' is being ignored.'); + {$endif} + exit; + end; + end; + cm:=TClassMode.Create; + cm.HClass:=IgnClass; + cm.PropertiesToIgnore.Add(propertyname); + TP_GlobalClassHandling.Add(cm); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Globally, the '+propertyname+' property of class '+IgnClass.ClassName+' is being ignored.'); + {$endif} +end; + +procedure TGnuGettextInstance.TP_Ignore(AnObject: TObject; + const name: string); +begin + TP_IgnoreList.Add(uppercase(name)); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('On object with class name '+AnObject.ClassName+', ignore is set on '+name); + {$endif} +end; + +procedure TGnuGettextInstance.TranslateComponent(AnObject: TComponent; + const TextDomain: string); +var + comp:TGnuGettextComponentMarker; +begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('======================================================================'); + DebugWriteln ('TranslateComponent() was called for a component with name '+AnObject.Name+'.'); + {$endif} + comp:=AnObject.FindComponent('GNUgettextMarker') as TGnuGettextComponentMarker; + if comp=nil then begin + comp:=TGnuGettextComponentMarker.Create (nil); + comp.Name:='GNUgettextMarker'; + comp.Retranslator:=TP_CreateRetranslator; + TranslateProperties (AnObject, TextDomain); + AnObject.InsertComponent(comp); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('This is the first time, that this component has been translated. A retranslator component has been created for this component.'); + {$endif} + end else begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('This is not the first time, that this component has been translated.'); + {$endif} + if comp.LastLanguage<>curlang then begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('ERROR: TranslateComponent() was called twice with different languages. This indicates an attempt to switch language at runtime, but by using TranslateComponent every time. This API has changed - please use RetranslateComponent() instead.'); + {$endif} + {$ifdef mswindows} + MessageBox (0,'This application tried to switch the language, but in an incorrect way. The programmer needs to replace a call to TranslateComponent with a call to RetranslateComponent(). The programmer should see the changelog of gnugettext.pas for more information.','Error',MB_OK); + {$else} + writeln (stderr,'This application tried to switch the language, but in an incorrect way. The programmer needs to replace a call to TranslateComponent with a call to RetranslateComponent(). The programmer should see the changelog of gnugettext.pas for more information.'); + {$endif} + end else begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('ERROR: TranslateComponent has been called twice, but with the same language chosen. This is a mistake, but in order to prevent that the application breaks, no exception is raised.'); + {$endif} + end; + end; + comp.LastLanguage:=curlang; + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('======================================================================'); + {$endif} +end; + +procedure TGnuGettextInstance.TranslateProperty (AnObject:TObject; PropInfo:PPropInfo; TodoList:TStrings; const TextDomain:string); +var + {$ifdef DELPHI5OROLDER} + ws: string; + old: string; + {$endif} + {$ifndef DELPHI5OROLDER} + ppi:PPropInfo; + ws: WideString; + old: WideString; + {$endif} + obj:TObject; + Propname:string; +begin + PropName:=PropInfo^.Name; + try + // Translate certain types of properties + case PropInfo^.PropType^.Kind of + tkString, tkLString, tkWString: + begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Translating '+AnObject.ClassName+'.'+PropName); + {$endif} + {$ifdef DELPHI5OROLDER} + old := GetStrProp(AnObject, PropName); + {$endif} + {$ifndef DELPHI5OROLDER} + if PropInfo^.PropType^.Kind<>tkWString then + old := ansi2wide(GetStrProp(AnObject, PropName)) + else + old := GetWideStrProp(AnObject, PropName); + {$endif} + {$ifdef DXGETTEXTDEBUG} + if old='' then + DebugWriteln ('(Empty, not translated)') + else + DebugWriteln ('Old value: "'+old+'"'); + {$endif} + if (old <> '') and (IsWriteProp(PropInfo)) then begin + if TP_Retranslator<>nil then + (TP_Retranslator as TTP_Retranslator).Remember(AnObject, PropName, old); + ws := dgettext(textdomain,old); + if ws <> old then begin + {$ifdef DELPHI5OROLDER} + SetStrProp(AnObject, PropName, ws); + {$endif} + {$ifndef DELPHI5OROLDER} + ppi:=GetPropInfo(AnObject, Propname); + if ppi<>nil then begin + SetWideStrProp(AnObject, ppi, ws); + end else begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('ERROR: Property disappeared: '+Propname+' for object of type '+AnObject.ClassName); + {$endif} + end; + {$endif} + end; + end; + end { case item }; + tkClass: + begin +// obj:=GetObjectProp(AnObject, PropName); +// if obj<>nil then +// TodoList.AddObject ('',obj); + end { case item }; + end { case }; + except + on E:Exception do + raise EGGComponentError.Create ('Property cannot be translated.'+sLineBreak+ + 'Add TP_GlobalIgnoreClassProperty('+AnObject.ClassName+','''+PropName+''') to your source code or use'+sLineBreak+ + 'TP_Ignore (self,''.'+PropName+''') to prevent this message.'+sLineBreak+ + 'Reason: '+e.Message); + end; +end; + +procedure TGnuGettextInstance.TranslateProperties(AnObject: TObject; textdomain:string=''); +var + TodoList:TStringList; // List of Name/TObject's that is to be processed + DoneList:TStringList; // List of hex codes representing pointers to objects that have been done + i, j, Count: integer; + PropList: PPropList; + UPropName: string; + PropInfo: PPropInfo; + comp:TComponent; + cm,currentcm:TClassMode; + ObjectPropertyIgnoreList:TStringList; + objid, Name:string; + {$ifdef DELPHI5OROLDER} + Data:PTypeData; + {$endif} +begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('----------------------------------------------------------------------'); + DebugWriteln ('TranslateProperties() was called for an object of class '+AnObject.ClassName+' with domain "'+textdomain+'".'); + {$endif} + if textdomain='' then + textdomain:=curmsgdomain; + if TP_Retranslator<>nil then + (TP_Retranslator as TTP_Retranslator).TextDomain:=textdomain; + DoneList:=TStringList.Create; + TodoList:=TStringList.Create; + ObjectPropertyIgnoreList:=TStringList.Create; + try + TodoList.AddObject('', AnObject); + DoneList.Sorted:=True; + ObjectPropertyIgnoreList.Sorted:=True; + {$ifndef DELPHI5OROLDER} + ObjectPropertyIgnoreList.Duplicates:=dupIgnore; + ObjectPropertyIgnoreList.CaseSensitive:=False; + DoneList.Duplicates:=dupError; + DoneList.CaseSensitive:=True; + {$endif} + + while TodoList.Count<>0 do begin + AnObject:=TodoList.Objects[0]; + Name:=TodoList.Strings[0]; + TodoList.Delete(0); + if (AnObject<>nil) and (AnObject is TPersistent) then begin + // Make sure each object is only translated once + Assert (sizeof(integer)=sizeof(TObject)); + objid:=IntToHex(integer(AnObject),8); + if DoneList.Find(objid,i) then begin + continue; + end else begin + DoneList.Add(objid); + end; + + ObjectPropertyIgnoreList.Clear; + + // Find out if there is special handling of this object + currentcm:=nil; + // First check the local handling instructions + for j:=0 to TP_ClassHandling.Count-1 do begin + cm:=TObject(TP_ClassHandling.Items[j]) as TClassMode; + if AnObject.InheritsFrom(cm.HClass) then begin + if cm.PropertiesToIgnore.Count<>0 then begin + ObjectPropertyIgnoreList.AddStrings(cm.PropertiesToIgnore); + end else begin + // Ignore the entire class + currentcm:=cm; + break; + end; + end; + end; + // Then check the global handling instructions + if currentcm=nil then + for j:=0 to TP_GlobalClassHandling.Count-1 do begin + cm:=TObject(TP_GlobalClassHandling.Items[j]) as TClassMode; + if AnObject.InheritsFrom(cm.HClass) then begin + if cm.PropertiesToIgnore.Count<>0 then begin + ObjectPropertyIgnoreList.AddStrings(cm.PropertiesToIgnore); + end else begin + // Ignore the entire class + currentcm:=cm; + break; + end; + end; + end; + if currentcm<>nil then begin + ObjectPropertyIgnoreList.Clear; + // Ignore or use special handler + if Assigned(currentcm.SpecialHandler) then begin + currentcm.SpecialHandler (AnObject); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Special handler activated for '+AnObject.ClassName); + {$endif} + end else begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Ignoring object '+AnObject.ClassName); + {$endif} + end; + continue; + end; + + {$ifdef DELPHI5OROLDER} + if AnObject.ClassInfo=nil then begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('ClassInfo=nil encountered for class '+AnObject.ClassName+'. Translation of that component has stopped. You should ignore this object.'); + {$endif} + continue; + end; + Data := GetTypeData(AnObject.Classinfo); + Count := Data^.PropCount; + GetMem(PropList, Count * Sizeof(PPropInfo)); + {$endif} + {$ifndef DELPHI5OROLDER} + Count := GetPropList(AnObject, PropList); + {$endif} + try + {$ifdef DELPHI5OROLDER} + GetPropInfos(AnObject.ClassInfo, PropList); + {$endif} + for j := 0 to Count - 1 do begin + PropInfo := PropList[j]; + UPropName:=uppercase(PropInfo^.Name); + // Ignore properties that are meant to be ignored + if ((currentcm=nil) or (not currentcm.PropertiesToIgnore.Find(UPropName,i))) and + (not TP_IgnoreList.Find(Name+'.'+UPropName,i)) and + (not ObjectPropertyIgnoreList.Find(UPropName,i)) then begin + TranslateProperty (AnObject,PropInfo,TodoList,TextDomain); + end; // if + end; // for + finally + {$ifdef DELPHI5OROLDER} + FreeMem(PropList, Data^.PropCount * Sizeof(PPropInfo)); + {$endif} + {$ifndef DELPHI5OROLDER} + if Count<>0 then + FreeMem (PropList); + {$endif} + end; + if AnObject is TStrings then begin + if ((AnObject as TStrings).Text<>'') and (TP_Retranslator<>nil) then + (TP_Retranslator as TTP_Retranslator).Remember(AnObject, 'Text', (AnObject as TStrings).Text); + TranslateStrings (AnObject as TStrings,TextDomain); + end; + // Check for TCollection + if AnObject is TCollection then begin + for i := 0 to (AnObject as TCollection).Count - 1 do + TodoList.AddObject('',(AnObject as TCollection).Items[i]); + end; + if AnObject is TComponent then begin + for i := 0 to TComponent(AnObject).ComponentCount - 1 do begin + comp:=TComponent(AnObject).Components[i]; + if (not TP_IgnoreList.Find(uppercase(comp.Name),j)) then begin + TodoList.AddObject(uppercase(comp.Name),comp); + end; + end; + end; + end { if AnObject<>nil }; + end { while todolist.count<>0 }; + finally + FreeAndNil (todolist); + FreeAndNil (ObjectPropertyIgnoreList); + FreeAndNil (DoneList); + end; + FreeTP_ClassHandlingItems; + TP_IgnoreList.Clear; + TP_Retranslator:=nil; + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('----------------------------------------------------------------------'); + {$endif} +end; + +procedure TGnuGettextInstance.UseLanguage(LanguageCode: string); +var + i,p:integer; + dom:TDomain; + l2:string[2]; +begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln('UseLanguage('''+LanguageCode+'''); called'); + {$endif} + + if LanguageCode='' then begin + LanguageCode:=GGGetEnvironmentVariable('LANG'); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('LANG env variable is '''+LanguageCode+'''.'); + {$endif} + {$ifdef MSWINDOWS} + if LanguageCode='' then begin + LanguageCode:=GetWindowsLanguage; + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Found Windows language code to be '''+LanguageCode+'''.'); + {$endif} + end; + {$endif} + p:=pos('.',LanguageCode); + if p<>0 then + LanguageCode:=copy(LanguageCode,1,p-1); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Language code that will be set is '''+LanguageCode+'''.'); + {$endif} + end; + + curlang := LanguageCode; + for i:=0 to domainlist.Count-1 do begin + dom:=domainlist.Objects[i] as TDomain; + dom.SetLanguageCode (curlang); + end; + + l2:=lowercase(copy(curlang,1,2)); + if (l2='en') or (l2='de') then curGetPluralForm:=GetPluralForm2EN else + if (l2='hu') or (l2='ko') or (l2='zh') or (l2='ja') or (l2='tr') then curGetPluralForm:=GetPluralForm1 else + if (l2='fr') or (l2='fa') or (lowercase(curlang)='pt_br') then curGetPluralForm:=GetPluralForm2FR else + if (l2='lv') then curGetPluralForm:=GetPluralForm3LV else + if (l2='ga') then curGetPluralForm:=GetPluralForm3GA else + if (l2='lt') then curGetPluralForm:=GetPluralForm3LT else + if (l2='ru') or (l2='cs') or (l2='sk') or (l2='uk') or (l2='hr') then curGetPluralForm:=GetPluralForm3RU else + if (l2='pl') then curGetPluralForm:=GetPluralForm3PL else + if (l2='sl') then curGetPluralForm:=GetPluralForm4SL else begin + curGetPluralForm:=GetPluralForm2EN; + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Plural form for the language was not found. English plurality system assumed.'); + {$endif} + end; + + WhenNewLanguage (curlang); + + {$ifdef DXGETTEXTDEBUG} + DebugWriteln(''); + {$endif} +end; + +procedure TGnuGettextInstance.TranslateStrings(sl: TStrings;const TextDomain:string); +var + line: string; + i: integer; + s:TStringList; +begin + if sl.Count > 0 then begin + sl.BeginUpdate; + try + s:=TStringList.Create; + try + s.Assign (sl); + for i:=0 to s.Count-1 do begin + line:=s.Strings[i]; + if line<>'' then + s.Strings[i]:=dgettext(TextDomain,line); + end; + sl.Assign(s); + finally + FreeAndNil (s); + end; + finally + sl.EndUpdate; + end; + end; +end; + +function TGnuGettextInstance.GetTranslatorNameAndEmail: widestring; +begin + Result:=GetTranslationProperty('LAST-TRANSLATOR'); +end; + +function TGnuGettextInstance.GetTranslationProperty( + const Propertyname: string): WideString; +begin + Result:=getdomain(curmsgdomain,DefaultDomainDirectory,CurLang).GetTranslationProperty (Propertyname); +end; + +function TGnuGettextInstance.dngettext(const szDomain: string; const singular, plural: widestring; + Number: Integer): widestring; +var + org,trans:widestring; + idx:integer; + p:integer; +begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('dngettext translation (domain '+szDomain+', number is '+IntTostr(Number)+') of '+singular+'/'+plural); + {$endif} + org:=singular+#0+plural; + trans:=dgettext(szDomain,org); + if org=trans then begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Translation was equal to english version. English plural forms assumed.'); + {$endif} + idx:=GetPluralForm2EN(Number) + end else + idx:=curGetPluralForm(Number); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Index '+IntToStr(idx)+' will be used'); + {$endif} + while true do begin + p:=pos(#0,trans); + if p=0 then begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Last translation used: '+utf8encode(trans)); + {$endif} + Result:=trans; + exit; + end; + if idx=0 then begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Translation found: '+utf8encode(trans)); + {$endif} + Result:=copy(trans,1,p-1); + exit; + end; + delete (trans,1,p); + dec (idx); + end; +end; + +{$ifndef DELPHI5OROLDER} +function TGnuGettextInstance.ngettext(const singular, plural: ansistring; + Number: Integer): widestring; +begin + Result := dngettext(curmsgdomain, singular, plural, Number); +end; +{$endif} + +function TGnuGettextInstance.ngettext(const singular, plural: widestring; + Number: Integer): widestring; +begin + Result := dngettext(curmsgdomain, singular, plural, Number); +end; + +procedure TGnuGettextInstance.WhenNewDomain(const TextDomain: string); +begin + // This is meant to be empty. +end; + +procedure TGnuGettextInstance.WhenNewLanguage(const LanguageID: string); +begin + // This is meant to be empty. +end; + +procedure TGnuGettextInstance.WhenNewDomainDirectory(const TextDomain, + Directory: string); +begin + // This is meant to be empty. +end; + +procedure TGnuGettextInstance.GetListOfLanguages(const domain: string; + list: TStrings); +begin + getdomain(Domain,DefaultDomainDirectory,CurLang).GetListOfLanguages(list); +end; + +procedure TGnuGettextInstance.bindtextdomainToFile(const szDomain, + filename: string); +begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Text domain "'+szDomain+'" is now bound to file named "'+filename+'"'); + {$endif} + getdomain(szDomain,DefaultDomainDirectory,CurLang).SetFilename (filename); +end; + +procedure TGnuGettextInstance.DebugLogPause(PauseEnabled: boolean); +begin + DebugLogOutputPaused:=PauseEnabled; +end; + +procedure TGnuGettextInstance.DebugLogToFile(const filename: string; append:boolean=false); +{$ifdef DXGETTEXTDEBUG} +var + fs:TFileStream; + marker:string; +{$endif} +begin + {$ifdef DXGETTEXTDEBUG} + // Create the file if needed + if (not fileexists(filename)) or (not append) then + fileclose (filecreate (filename)); + + // Open file + fs:=TFileStream.Create (filename,fmOpenWrite or fmShareDenyWrite); + if append then + fs.Seek(0,soFromEnd); + + // Write header if appending + if fs.Position<>0 then begin + marker:=sLineBreak+'==========================================================================='+sLineBreak; + fs.WriteBuffer(marker[1],length(marker)); + end; + + // Copy the memorystream contents to the file + DebugLog.Seek(0,soFromBeginning); + fs.CopyFrom(DebugLog,0); + + // Make DebugLog point to the filestream + FreeAndNil (DebugLog); + DebugLog:=fs; +{$endif} +end; + +procedure TGnuGettextInstance.DebugWriteln(line: ansistring); +Var + Discard: Boolean; +begin + Assert (DebugLogCS<>nil); + Assert (DebugLog<>nil); + + DebugLogCS.BeginWrite; + try + if DebugLogOutputPaused then + exit; + + if Assigned (fOnDebugLine) then begin + Discard := True; + fOnDebugLine (Self, Line, Discard); + If Discard then Exit; + end; + + line:=line+sLineBreak; + + // Ensure that memory usage doesn't get too big. + if (DebugLog is TMemoryStream) and (DebugLog.Position>1000000) then begin + line:=sLineBreak+sLineBreak+sLineBreak+sLineBreak+sLineBreak+ + 'Debug log halted because memory usage grew too much.'+sLineBreak+ + 'Specify a filename to store the debug log in or disable debug loggin in gnugettext.pas.'+ + sLineBreak+sLineBreak+sLineBreak+sLineBreak+sLineBreak; + DebugLogOutputPaused:=True; + end; + DebugLog.WriteBuffer(line[1],length(line)); + finally + DebugLogCS.EndWrite; + end; +end; + +function TGnuGettextInstance.Getdomain(const domain, DefaultDomainDirectory, CurLang: string): TDomain; +// Retrieves the TDomain object for the specified domain. +// Creates one, if none there, yet. +var + idx: integer; +begin + idx := domainlist.IndexOf(Domain); + if idx = -1 then begin + Result := TDomain.Create; + Result.DebugLogger:=DebugWriteln; + Result.Domain := Domain; + Result.Directory := DefaultDomainDirectory; + Result.SetLanguageCode(curlang); + domainlist.AddObject(Domain, Result); + end else begin + Result := domainlist.Objects[idx] as TDomain; + end; +end; + +function TGnuGettextInstance.LoadResString( + ResStringRec: PResStringRec): widestring; +{$ifdef MSWINDOWS} +var + Len: Integer; + Buffer: array [0..1023] of char; +{$endif} +{$ifdef LINUX } +const + ResStringTableLen = 16; +type + ResStringTable = array [0..ResStringTableLen-1] of LongWord; +var + Handle: TResourceHandle; + Tab: ^ResStringTable; + ResMod: HMODULE; +{$endif } +begin + if ResStringRec=nil then + exit; + if ResStringRec.Identifier>=64*1024 then begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('LoadResString was given an invalid ResStringRec.Identifier'); + {$endif} + Result:='ERROR'; + exit; + end else begin + {$ifdef LINUX} + // This works with Unicode if the Linux has utf-8 character set + // Result:=System.LoadResString(ResStringRec); + ResMod:=FindResourceHInstance(ResStringRec^.Module^); + Handle:=FindResource(ResMod, + PChar(ResStringRec^.Identifier div ResStringTableLen), PChar(6)); // RT_STRING + Tab:=Pointer(LoadResource(ResMod, Handle)); + if Tab=nil then + Result:='' + else + Result:=PWideChar(PChar(Tab)+Tab[ResStringRec^.Identifier mod ResStringTableLen]); + {$endif} + {$ifdef MSWINDOWS} + if not Win32PlatformIsUnicode then begin + SetString(Result, Buffer, + LoadString(FindResourceHInstance(ResStringRec.Module^), + ResStringRec.Identifier, Buffer, SizeOf(Buffer))) + end else begin + Result := ''; + Len := 0; + While Len = Length(Result) do begin + if Length(Result) = 0 then + SetLength(Result, 1024) + else + SetLength(Result, Length(Result) * 2); + Len := LoadStringW(FindResourceHInstance(ResStringRec.Module^), + ResStringRec.Identifier, PWideChar(Result), Length(Result)); + end; + SetLength(Result, Len); + end; + {$endif} + end; + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Loaded resourcestring: '+utf8encode(Result)); + {$endif} + if CreatorThread<>GetCurrentThreadId then begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('LoadResString was called from an invalid thread. Resourcestring was not translated.'); + {$endif} + end else + Result:=ResourceStringGettext(Result); +end; + +procedure TGnuGettextInstance.RetranslateComponent(AnObject: TComponent; + const TextDomain: string); +var + comp:TGnuGettextComponentMarker; +begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('======================================================================'); + DebugWriteln ('RetranslateComponent() was called for a component with name '+AnObject.Name+'.'); + {$endif} + comp:=AnObject.FindComponent('GNUgettextMarker') as TGnuGettextComponentMarker; + if comp=nil then begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Retranslate was called on an object that has not been translated before. An Exception is being raised.'); + {$endif} + raise EGGProgrammingError.Create ('Retranslate was called on an object that has not been translated before. Please use TranslateComponent() before RetranslateComponent().'); + end else begin + if comp.LastLanguage<>curlang then begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('The retranslator is being executed.'); + {$endif} + comp.Retranslator.Execute; + end else begin + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('The language has not changed. The retranslator is not executed.'); + {$endif} + end; + end; + comp.LastLanguage:=curlang; + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('======================================================================'); + {$endif} +end; + +procedure TGnuGettextInstance.TP_IgnoreClass(IgnClass: TClass); +var + cm:TClassMode; + i:integer; +begin + for i:=0 to TP_ClassHandling.Count-1 do begin + cm:=TObject(TP_ClassHandling.Items[i]) as TClassMode; + if cm.HClass=IgnClass then + raise EGGProgrammingError.Create ('You cannot add a class to the ignore list that is already on that list: '+IgnClass.ClassName+'.'); + if IgnClass.InheritsFrom(cm.HClass) then begin + // This is the place to insert this class + cm:=TClassMode.Create; + cm.HClass:=IgnClass; + TP_ClassHandling.Insert(i,cm); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Locally, class '+IgnClass.ClassName+' is being ignored.'); + {$endif} + exit; + end; + end; + cm:=TClassMode.Create; + cm.HClass:=IgnClass; + TP_ClassHandling.Add(cm); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Locally, class '+IgnClass.ClassName+' is being ignored.'); + {$endif} +end; + +procedure TGnuGettextInstance.TP_IgnoreClassProperty(IgnClass: TClass; + propertyname: string); +var + cm:TClassMode; + i:integer; +begin + propertyname:=uppercase(propertyname); + for i:=0 to TP_ClassHandling.Count-1 do begin + cm:=TObject(TP_ClassHandling.Items[i]) as TClassMode; + if cm.HClass=IgnClass then begin + if Assigned(cm.SpecialHandler) then + raise EGGProgrammingError.Create ('You cannot ignore a class property for a class that has a handler set.'); + cm.PropertiesToIgnore.Add(propertyname); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Globally, the '+propertyname+' property of class '+IgnClass.ClassName+' is being ignored.'); + {$endif} + exit; + end; + if IgnClass.InheritsFrom(cm.HClass) then begin + // This is the place to insert this class + cm:=TClassMode.Create; + cm.HClass:=IgnClass; + cm.PropertiesToIgnore.Add(propertyname); + TP_ClassHandling.Insert(i,cm); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Locally, the '+propertyname+' property of class '+IgnClass.ClassName+' is being ignored.'); + {$endif} + exit; + end; + end; + cm:=TClassMode.Create; + cm.HClass:=IgnClass; + cm.PropertiesToIgnore.Add(propertyname); + TP_GlobalClassHandling.Add(cm); + {$ifdef DXGETTEXTDEBUG} + DebugWriteln ('Locally, the '+propertyname+' property of class '+IgnClass.ClassName+' is being ignored.'); + {$endif} +end; + +procedure TGnuGettextInstance.FreeTP_ClassHandlingItems; +begin + while TP_ClassHandling.Count<>0 do begin + TObject(TP_ClassHandling.Items[0]).Free; + TP_ClassHandling.Delete(0); + end; +end; + +function TGnuGettextInstance.ansi2wide(const s: ansistring): widestring; +{$ifdef MSWindows} +var + len:integer; +{$endif} +begin +{$ifdef MSWindows} + if DesignTimeCodePage=CP_ACP then begin + // No design-time codepage specified. Using runtime codepage instead. +{$endif} + Result:=s; +{$ifdef MSWindows} + end else begin + len:=length(s); + if len=0 then + Result:='' + else begin + SetLength (Result,len); + len:=MultiByteToWideChar(DesignTimeCodePage,0,pchar(s),len,pwidechar(Result),len); + if len=0 then + raise EGGAnsi2WideConvError.Create ('Cannot convert string to widestring:'+sLineBreak+s); + SetLength (Result,len); + end; + end; +{$endif} +end; + +{$ifndef DELPHI5OROLDER} +function TGnuGettextInstance.dngettext(const szDomain: string; const singular, + plural: ansistring; Number: Integer): widestring; +begin + Result:=dngettext (szDomain, ansi2wide(singular), ansi2wide(plural), Number); +end; +{$endif} + +{ TClassMode } + +constructor TClassMode.Create; +begin + PropertiesToIgnore:=TStringList.Create; + PropertiesToIgnore.Sorted:=True; + PropertiesToIgnore.Duplicates:=dupError; + {$ifndef DELPHI5OROLDER} + PropertiesToIgnore.CaseSensitive:=False; + {$endif} +end; + +destructor TClassMode.Destroy; +begin + FreeAndNil (PropertiesToIgnore); + inherited; +end; + +{ TFileLocator } + +procedure TFileLocator.Analyze; +var + s:ansistring; + i:integer; + offset:int64; + fs:TFileStream; + fi:TEmbeddedFileInfo; + filename:string; +begin + s:='6637DB2E-62E1-4A60-AC19-C23867046A89'#0#0#0#0#0#0#0#0; + s:=copy(s,length(s)-7,8); + offset:=0; + for i:=8 downto 1 do + offset:=offset shl 8+ord(s[i]); + if offset=0 then + exit; + BaseDirectory:=ExtractFilePath(ExecutableFilename); + try + fs:=TFileStream.Create(ExecutableFilename,fmOpenRead or fmShareDenyNone); + try + while true do begin + fs.Seek(offset,soFromBeginning); + offset:=ReadInt64(fs); + if offset=0 then + exit; + fi:=TEmbeddedFileInfo.Create; + try + fi.Offset:=ReadInt64(fs); + fi.Size:=ReadInt64(fs); + SetLength (filename, offset-fs.position); + fs.ReadBuffer (filename[1],offset-fs.position); + filename:=trim(filename); + filelist.AddObject(filename,fi); + except + FreeAndNil (fi); + raise; + end; + end; + finally + FreeAndNil (fs); + end; + except + {$ifdef DXGETTEXTDEBUG} + raise; + {$endif} + end; +end; + +constructor TFileLocator.Create; +begin + MoFilesCS:=TMultiReadExclusiveWriteSynchronizer.Create; + MoFiles:=TStringList.Create; + filelist:=TStringList.Create; + {$ifdef LINUX} + filelist.Duplicates:=dupError; + filelist.CaseSensitive:=True; + {$endif} + MoFiles.Sorted:=True; + {$ifndef DELPHI5OROLDER} + MoFiles.Duplicates:=dupError; + MoFiles.CaseSensitive:=False; + {$ifdef MSWINDOWS} + filelist.Duplicates:=dupError; + filelist.CaseSensitive:=False; + {$endif} + {$endif} + filelist.Sorted:=True; +end; + +destructor TFileLocator.Destroy; +begin + while filelist.count<>0 do begin + filelist.Objects[0].Free; + filelist.Delete (0); + end; + FreeAndNil (filelist); + FreeAndNil (MoFiles); + FreeAndNil (MoFilesCS); + inherited; +end; + +function TFileLocator.FileExists(filename: string): boolean; +var + idx:integer; +begin + if copy(filename,1,length(basedirectory))=basedirectory then + filename:=copy(filename,length(basedirectory)+1,maxint); + Result:=filelist.Find(filename,idx); +end; + +function TFileLocator.GetMoFile(filename: string; DebugLogger:TDebugLogger): TMoFile; +var + fi:TEmbeddedFileInfo; + idx:integer; + idxname:string; + Offset, Size: Int64; + realfilename:string; +begin + // Find real filename + offset:=0; + size:=0; + realfilename:=filename; + if copy(filename,1,length(basedirectory))=basedirectory then begin + filename:=copy(filename,length(basedirectory)+1,maxint); + idx:=filelist.IndexOf(filename); + if idx<>-1 then begin + fi:=filelist.Objects[idx] as TEmbeddedFileInfo; + realfilename:=ExecutableFilename; + offset:=fi.offset; + size:=fi.size; + {$ifdef DXGETTEXTDEBUG} + DebugLogger ('Instead of '+filename+', using '+realfilename+' from offset '+IntTostr(offset)+', size '+IntToStr(size)); + {$endif} + end; + end; + + + {$ifdef DXGETTEXTDEBUG} + DebugLogger ('Reading .mo data from file '''+filename+''''); + {$endif} + + // Find TMoFile object + MoFilesCS.BeginWrite; + try + idxname:=realfilename+#0+IntToStr(offset); + if MoFiles.Find(idxname, idx) then begin + Result:=MoFiles.Objects[idx] as TMoFile; + end else begin + Result:=TMoFile.Create (realfilename, Offset, Size); + MoFiles.AddObject(idxname, Result); + end; + Inc (Result.Users); + finally + MoFilesCS.EndWrite; + end; +end; + +function TFileLocator.ReadInt64(str: TStream): int64; +begin + Assert (sizeof(Result)=8); + str.ReadBuffer(Result,8); +end; + +procedure TFileLocator.ReleaseMoFile(mofile: TMoFile); +var + i:integer; +begin + Assert (mofile<>nil); + + MoFilesCS.BeginWrite; + try + dec (mofile.Users); + if mofile.Users<=0 then begin + i:=MoFiles.Count-1; + while i>=0 do begin + if MoFiles.Objects[i]=mofile then begin + MoFiles.Delete(i); + FreeAndNil (mofile); + break; + end; + dec (i); + end; + end; + finally + MoFilesCS.EndWrite; + end; +end; + +{ TTP_Retranslator } + +constructor TTP_Retranslator.Create; +begin + list:=TList.Create; +end; + +destructor TTP_Retranslator.Destroy; +var + i:integer; +begin + for i:=0 to list.Count-1 do + TObject(list.Items[i]).Free; + FreeAndNil (list); + inherited; +end; + +procedure TTP_Retranslator.Execute; +var + i:integer; + sl:TStrings; + item:TTP_RetranslatorItem; + newvalue:WideString; + {$ifndef DELPHI5OROLDER} + ppi:PPropInfo; + {$endif} +begin + for i:=0 to list.Count-1 do begin + item:=TObject(list.items[i]) as TTP_RetranslatorItem; + if item.obj is TStrings then begin + // Since we don't know the order of items in sl, and don't have + // the original .Objects[] anywhere, we cannot anticipate anything + // about the current sl.Strings[] and sl.Objects[] values. We therefore + // have to discard both values. We can, however, set the original .Strings[] + // value into the list and retranslate that. + sl:=TStringList.Create; + try + sl.Text:=item.OldValue; + Instance.TranslateStrings(sl,textdomain); + (item.obj as TStrings).BeginUpdate; + try + (item.obj as TStrings).Text:=sl.Text; + finally + (item.obj as TStrings).EndUpdate; + end; + finally + FreeAndNil (sl); + end; + end else begin + newValue:=instance.dgettext(textdomain,item.OldValue); + {$ifdef DELPHI5OROLDER} + SetStrProp(item.obj, item.PropName, newValue); + {$endif} + {$ifndef DELPHI5OROLDER} + ppi:=GetPropInfo(item.obj, item.Propname); + if ppi<>nil then begin + SetWideStrProp(item.obj, ppi, newValue); + end else begin + {$ifdef DXGETTEXTDEBUG} + Instance.DebugWriteln ('ERROR: On retranslation, property disappeared: '+item.Propname+' for object of type '+item.obj.ClassName); + {$endif} + end; + {$endif} + end; + end; +end; + +procedure TTP_Retranslator.Remember(obj: TObject; PropName: String; + OldValue: WideString); +var + item:TTP_RetranslatorItem; +begin + item:=TTP_RetranslatorItem.Create; + item.obj:=obj; + item.Propname:=Propname; + item.OldValue:=OldValue; + list.Add(item); +end; + +{ TGnuGettextComponentMarker } + +destructor TGnuGettextComponentMarker.Destroy; +begin + FreeAndNil (Retranslator); + inherited; +end; + +{ THook } + +constructor THook.Create(OldProcedure, NewProcedure: pointer; FollowJump:boolean=false); +{ Idea and original code from Igor Siticov } +{ Modified by Jacques Garcia Vazquez and Lars Dybdahl } +begin + {$ifndef CPU386} + 'This procedure only works on Intel i386 compatible processors.' + {$endif} + + oldproc:=OldProcedure; + newproc:=NewProcedure; + + Reset (FollowJump); +end; + +destructor THook.Destroy; +begin + Shutdown; + inherited; +end; + +procedure THook.Disable; +begin + Assert (PatchPosition<>nil,'Patch position in THook was nil when Disable was called'); + PatchPosition[0]:=Original[0]; + PatchPosition[1]:=Original[1]; + PatchPosition[2]:=Original[2]; + PatchPosition[3]:=Original[3]; + PatchPosition[4]:=Original[4]; +end; + +procedure THook.Enable; +begin + Assert (PatchPosition<>nil,'Patch position in THook was nil when Enable was called'); + PatchPosition[0]:=Patch[0]; + PatchPosition[1]:=Patch[1]; + PatchPosition[2]:=Patch[2]; + PatchPosition[3]:=Patch[3]; + PatchPosition[4]:=Patch[4]; +end; + +procedure THook.Reset(FollowJump: boolean); +var + offset:integer; + {$ifdef LINUX} + p:pointer; + pagesize:integer; + {$endif} + {$ifdef MSWindows} + ov: cardinal; + {$endif} +begin + if PatchPosition<>nil then + Shutdown; + + patchPosition := OldProc; + if FollowJump and (Word(OldProc^) = $25FF) then begin + // This finds the correct procedure if a virtual jump has been inserted + // at the procedure address + Inc(Integer(patchPosition), 2); // skip the jump + patchPosition := pChar(Pointer(pointer(patchPosition)^)^); + end; + offset:=integer(NewProc)-integer(pointer(patchPosition))-5; + + Patch[0] := char($E9); + Patch[1] := char(offset and 255); + Patch[2] := char((offset shr 8) and 255); + Patch[3] := char((offset shr 16) and 255); + Patch[4] := char((offset shr 24) and 255); + + Original[0]:=PatchPosition[0]; + Original[1]:=PatchPosition[1]; + Original[2]:=PatchPosition[2]; + Original[3]:=PatchPosition[3]; + Original[4]:=PatchPosition[4]; + + {$ifdef MSWINDOWS} + if not VirtualProtect(Pointer(PatchPosition), 5, PAGE_EXECUTE_READWRITE, @ov) then + RaiseLastOSError; + {$endif} + {$ifdef LINUX} + pageSize:=sysconf (_SC_PAGE_SIZE); + p:=pointer(PatchPosition); + p:=pointer((integer(p) + PAGESIZE-1) and not (PAGESIZE-1) - pageSize); + if mprotect (p, pageSize, PROT_READ + PROT_WRITE + PROT_EXEC) <> 0 then + RaiseLastOSError; + {$endif} +end; + +procedure THook.Shutdown; +begin + Disable; + PatchPosition:=nil; +end; + +procedure HookIntoResourceStrings (enabled:boolean=true; SupportPackages:boolean=false); +begin + HookLoadResString.Reset (SupportPackages); + HookLoadStr.Reset (SupportPackages); + HookFmtLoadStr.Reset (SupportPackages); + if enabled then begin + HookLoadResString.Enable; + HookLoadStr.Enable; + HookFmtLoadStr.Enable; + end; +end; + +{ TMoFile } + +function TMoFile.autoswap32(i: cardinal): cardinal; +var + cnv1, cnv2: + record + case integer of + 0: (arr: array[0..3] of byte); + 1: (int: cardinal); + end; +begin + if doswap then begin + cnv1.int := i; + cnv2.arr[0] := cnv1.arr[3]; + cnv2.arr[1] := cnv1.arr[2]; + cnv2.arr[2] := cnv1.arr[1]; + cnv2.arr[3] := cnv1.arr[0]; + Result := cnv2.int; + end else + Result := i; +end; + +function TMoFile.CardinalInMem(baseptr: PChar; Offset: Cardinal): Cardinal; +var pc:^Cardinal; +begin + inc (baseptr,offset); + pc:=Pointer(baseptr); + Result:=pc^; + if doswap then + autoswap32(Result); +end; + +constructor TMoFile.Create(filename: string; Offset,Size:int64); +var + i:cardinal; + nn:integer; + {$ifdef linux} + mofile:TFileStream; + {$endif} +begin + if sizeof(i) <> 4 then + raise EGGProgrammingError.Create('TDomain in gnugettext is written for an architecture that has 32 bit integers.'); + + {$ifdef mswindows} + // Map the mo file into memory and let the operating system decide how to cache + mo:=createfile (PChar(filename),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); + if mo=INVALID_HANDLE_VALUE then + raise EGGIOError.Create ('Cannot open file '+filename); + momapping:=CreateFileMapping (mo, nil, PAGE_READONLY, 0, 0, nil); + if momapping=0 then + raise EGGIOError.Create ('Cannot create memory map on file '+filename); + momemoryHandle:=MapViewOfFile (momapping,FILE_MAP_READ,0,0,0); + if momemoryHandle=nil then begin + raise EGGIOError.Create ('Cannot map file '+filename+' into memory. Reason: '+GetLastWinError); + end; + momemory:=momemoryHandle+offset; + {$endif} + {$ifdef linux} + // Read the whole file into memory + mofile:=TFileStream.Create (filename, fmOpenRead or fmShareDenyNone); + try + if size=0 then + size:=mofile.Size; + Getmem (momemoryHandle,size); + momemory:=momemoryHandle; + mofile.Seek(offset,soFromBeginning); + mofile.ReadBuffer(momemory^,size); + finally + FreeAndNil (mofile); + end; + {$endif} + + // Check the magic number + doswap:=False; + i:=CardinalInMem(momemory,0); + if (i <> $950412DE) and (i <> $DE120495) then + EGGIOError.Create('This file is not a valid GNU gettext mo file: ' + filename); + doswap := (i = $DE120495); + + + // Find the positions in the file according to the file format spec + CardinalInMem(momemory,4); // Read the version number, but don't use it for anything. + N:=CardinalInMem(momemory,8); // Get string count + O:=CardinalInMem(momemory,12); // Get offset of original strings + T:=CardinalInMem(momemory,16); // Get offset of translated strings + + // Calculate start conditions for a binary search + nn := N; + startindex := 1; + while nn <> 0 do begin + nn := nn shr 1; + startindex := startindex shl 1; + end; + startindex := startindex shr 1; + startstep := startindex shr 1; +end; + +destructor TMoFile.Destroy; +begin + {$ifdef mswindows} + UnMapViewOfFile (momemoryHandle); + CloseHandle (momapping); + CloseHandle (mo); + {$endif} + {$ifdef linux} + FreeMem (momemoryHandle); + {$endif} + inherited; +end; + +function TMoFile.gettext(const msgid: ansistring;var found:boolean): ansistring; +var + i, step: cardinal; + offset, pos: cardinal; + CompareResult:integer; + msgidptr,a,b:PChar; + abidx:integer; + size, msgidsize:integer; +begin + found:=false; + msgidptr:=PChar(msgid); + msgidsize:=length(msgid); + + // Do binary search + i:=startindex; + step:=startstep; + while true do begin + // Get string for index i + pos:=O+8*(i-1); + offset:=CardinalInMem (momemory,pos+4); + size:=CardinalInMem (momemory,pos); + a:=msgidptr; + b:=momemory+offset; + abidx:=size; + if msgidsize0 do begin + CompareResult:=integer(byte(a^))-integer(byte(b^)); + if CompareResult<>0 then + break; + dec (abidx); + inc (a); + inc (b); + end; + if CompareResult=0 then + CompareResult:=msgidsize-size; + if CompareResult=0 then begin // msgid=s + // Found the msgid + pos:=T+8*(i-1); + offset:=CardinalInMem (momemory,pos+4); + size:=CardinalInMem (momemory,pos); + SetString (Result,momemory+offset,size); + found:=True; + break; + end; + if step=0 then begin + // Not found + Result:=msgid; + break; + end; + if CompareResult<0 then begin // msgids + i := i + step; + if i > N then + i := N; + step := step shr 1; + end; + end; +end; + +// DELPHI4 + +function GetPropInfo(Instance: TObject; const Name: string; var PropInfo: TPropInfo): Boolean; +var + Props: PPropList; + TypeData: PTypeData; + Info: PPropInfo; + i: Integer; +begin + TypeData := GetTypeData(Instance.ClassInfo); + if ((TypeData <> nil) and (TypeData^.PropCount > 0)) then + begin + GetMem(Props, TypeData^.PropCount * sizeof(Pointer)); + try + GetPropInfos(Instance.ClassInfo, Props); + for i := 0 to TypeData.PropCount - 1 do + begin + Info := Props[i]; + if (AnsiCompareText(Info.Name, Name) = 0) then + begin + PropInfo := Info^; + Result := True; + Exit; + end + end; + finally + FreeMem(Props); + end; + end; + Result := False; +end; + +function GetStrProp(Instance: TObject; Info: PPropInfo): string; +begin + Result := TypInfo.GetStrProp(Instance, Info); +end; + +function GetStrProp(Instance: TObject; const Name: string): string; +var + Info: TPropInfo; +begin + if GetPropInfo(Instance, Name, Info) then + Result := TypInfo.GetStrProp(Instance, @Info) + else + Result := ''; +end; + +procedure SetStrProp(Instance: TObject; const Name, Value: string); +var + Info: TPropInfo; +begin + if GetPropInfo(Instance, Name, Info) then + SetStrProp(Instance, @Info, Value); +end; + +procedure SetStrProp(Instance: TObject; Info: PPropInfo; const Value: string); +begin + TypInfo.SetStrProp(Instance, Info, Value); +end; + +initialization + {$ifdef DXGETTEXTDEBUG} + {$ifdef MSWINDOWS} + MessageBox (0,'gnugettext.pas debugging is enabled. Turn it off before releasing this piece of software.','Information',MB_OK); + {$endif} + {$ifdef LINUX} + writeln (stderr,'gnugettext.pas debugging is enabled. Turn it off before releasing this piece of software.'); + {$endif} + {$endif} + if IsLibrary then begin + // Get DLL/shared object filename + SetLength (ExecutableFilename,300); + {$ifdef MSWINDOWS} + SetLength (ExecutableFilename,GetModuleFileName(HInstance, PChar(ExecutableFilename), length(ExecutableFilename))); + {$else} + // This line has not been tested on Linux, yet, but should work. + SetLength (ExecutableFilename,GetModuleFileName(0, PChar(ExecutableFilename), length(ExecutableFilename))); + {$endif} + end else + ExecutableFilename:=Paramstr(0); + FileLocator:=TFileLocator.Create; + FileLocator.Analyze; + ResourceStringDomainList:=TStringList.Create; + ResourceStringDomainList.Add(DefaultTextDomain); + ResourceStringDomainListCS:=TMultiReadExclusiveWriteSynchronizer.Create; + DefaultInstance:=TGnuGettextInstance.Create; + {$ifdef MSWINDOWS} + Win32PlatformIsUnicode := (Win32Platform = VER_PLATFORM_WIN32_NT); + {$endif} + + // replace Borlands LoadResString with gettext enabled version: + HookLoadResString:=THook.Create (@system.LoadResString, @LoadResStringA); + HookLoadStr:=THook.Create (@sysutils.LoadStr, @SysUtilsLoadStr); + HookFmtLoadStr:=THook.Create (@sysutils.FmtLoadStr, @SysUtilsFmtLoadStr); + HookIntoResourceStrings (AutoCreateHooks,false); + +finalization + FreeAndNil (DefaultInstance); + FreeAndNil (ResourceStringDomainListCS); + FreeAndNil (ResourceStringDomainList); + FreeAndNil (HookFmtLoadStr); + FreeAndNil (HookLoadStr); + FreeAndNil (HookLoadResString); + FreeAndNil (FileLocator); + +end. + diff --git a/win32/gui-2/gnugettextD4.pas b/win32/gui-2/gnugettextD4.pas new file mode 100644 index 000000000..779bed16c --- /dev/null +++ b/win32/gui-2/gnugettextD4.pas @@ -0,0 +1,292 @@ +unit gnugettextD4; +(* File version: $Date: 2005/09/28 00:33:08 $ *) +(* Revision: $Revision: 1.1 $ *) +// Delphi 5 optimized interface for gnugettext.pas +// This unit must only be used on Delphi 5. When you upgrade to Delphi 6 or +// later, you should remove this unit and replace all reference to gnugettextD5 +// with refernces to gnugettext. + +interface + +uses + Classes; + +// Ansistring versions of the api +function _(const szMsgId: string): string; +function gettext(const szMsgId: string): string; +function dgettext(const szDomain: string; const szMsgId: string): string; +procedure TranslateComponent(AnObject: TComponent); + + + +//***************************************************************************** +// Don't use anything in the interface below this line. +// It only contains code or gnugettext.pas to make it compile with Delphi 5. + +type + UTF8String = AnsiString; + +const + PathDelim='\'; + sLineBreak=#13#10; + +function GetEnvironmentVariable(const VarName: string): string; +function DirectoryExists(const Name:string):boolean; +function IncludeTrailingPathDelimiter(s: string): string; +function ExcludeTrailingPathDelimiter(s: string): string; +procedure RaiseLastOSError; +function StrToFloatDef(const S:String;Default:Extended):Extended; +function Utf8Decode(const S: UTF8String): WideString; +function Utf8Encode(const WS: WideString): UTF8String; + +// for delphi 4 + +procedure FreeAndNil(var P); +function IncludeTrailingBackSlash(const Path: string): string; +function ExcludeTrailingBackslash(const Path: string): string; + +implementation + +uses + filectrl, Windows, SysUtils, + gnugettext; + +function GetEnvironmentVariable(const VarName: string): string; +var Size: Integer; +begin + Size := Windows.GetEnvironmentVariable(PChar(VarName), nil, 0); + SetLength(Result, Size - 1); + Windows.GetEnvironmentVariable(PChar(VarName), PChar(Result), Size); +end; + +function DirectoryExists(const Name:string):boolean; +begin + Result := FileCtrl.DirectoryExists(Name); +end; + +function IncludeTrailingPathDelimiter(s: string): string; +begin + Result := IncludeTrailingBackslash(s); +end; + +function ExcludeTrailingPathDelimiter(s: string): string; +begin + Result := ExcludeTrailingBackslash(s); +end; + +procedure RaiseLastOSError; +begin + RaiseLastWin32Error; +end; + +function StrToFloatDef(const S:String;Default:Extended):Extended; +begin + if not TextToFloat(PChar(S), Result, fvExtended) then + Result := Default; +end; + +function UnicodeToUtf8(Dest: PChar; MaxDestBytes: Cardinal; Source: PWideChar; SourceChars: Cardinal): Cardinal; +var + i, count: Cardinal; + c: Cardinal; +begin + Result := 0; + if Source = nil then + Exit; + count := 0; + i := 0; + if Dest <> nil then begin + while (i < SourceChars) and (count < MaxDestBytes) do begin + c := Cardinal(Source[i]); + Inc(i); + if c <= $7F then begin + Dest[count] := Char(c); + Inc(count); + end else + if c > $7FF then begin + if count + 3 > MaxDestBytes then + break; + Dest[count] := Char($E0 or (c shr 12)); + Dest[count + 1] := Char($80 or ((c shr 6) and $3F)); + Dest[count + 2] := Char($80 or (c and $3F)); + Inc(count, 3); + end else // $7F < Source[i] <= $7FF + begin + if count + 2 > MaxDestBytes then + break; + Dest[count] := Char($C0 or (c shr 6)); + Dest[count + 1] := Char($80 or (c and $3F)); + Inc(count, 2); + end; + end; + if count >= MaxDestBytes then + count := MaxDestBytes - 1; + Dest[count] := #0; + end else begin + while i < SourceChars do begin + c := Integer(Source[i]); + Inc(i); + if c > $7F then begin + if c > $7FF then + Inc(count); + Inc(count); + end; + Inc(count); + end; + end; + Result := count + 1; // convert zero based index to byte count +end; + +function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal; +var + i, count: Cardinal; + c: Byte; + wc: Cardinal; +begin + if Source = nil then begin + Result := 0; + Exit; + end; + Result := Cardinal(-1); + count := 0; + i := 0; + if Dest <> nil then begin + while (i < SourceBytes) and (count < MaxDestChars) do begin + wc := Cardinal(Source[i]); + Inc(i); + if (wc and $80) <> 0 then begin + if i >= SourceBytes then + Exit; // incomplete multibyte char + wc := wc and $3F; + if (wc and $20) <> 0 then begin + c := Byte(Source[i]); + Inc(i); + if (c and $C0) <> $80 then + Exit; // malformed trail byte or out of range char + if i >= SourceBytes then + Exit; // incomplete multibyte char + wc := (wc shl 6) or (c and $3F); + end; + c := Byte(Source[i]); + Inc(i); + if (c and $C0) <> $80 then + Exit; // malformed trail byte + + Dest[count] := WideChar((wc shl 6) or (c and $3F)); + end else + Dest[count] := WideChar(wc); + Inc(count); + end; + if count >= MaxDestChars then + count := MaxDestChars - 1; + Dest[count] := #0; + end else begin + while (i < SourceBytes) do begin + c := Byte(Source[i]); + Inc(i); + if (c and $80) <> 0 then begin + if i >= SourceBytes then + Exit; // incomplete multibyte char + c := c and $3F; + if (c and $20) <> 0 then begin + c := Byte(Source[i]); + Inc(i); + if (c and $C0) <> $80 then + Exit; // malformed trail byte or out of range char + if i >= SourceBytes then + Exit; // incomplete multibyte char + end; + c := Byte(Source[i]); + Inc(i); + if (c and $C0) <> $80 then + Exit; // malformed trail byte + end; + Inc(count); + end; + end; + Result := count + 1; +end; + +function Utf8Decode(const S: UTF8String): WideString; +var + L: Integer; + Temp: WideString; +begin + Result := ''; + if S = '' then + Exit; + SetLength(Temp, Length(S)); + + L := Utf8ToUnicode(PWideChar(Temp), Length(Temp) + 1, PChar(S), Length(S)); + if L > 0 then + SetLength(Temp, L - 1) + else + Temp := ''; + Result := Temp; +end; + +function Utf8Encode(const WS: WideString): UTF8String; +var + L: Integer; + Temp: UTF8String; +begin + Result := ''; + if WS = '' then + Exit; + SetLength(Temp, Length(WS) * 3); // SetLength includes space for null terminator + + L := UnicodeToUtf8(PChar(Temp), Length(Temp) + 1, PWideChar(WS), Length(WS)); + if L > 0 then + SetLength(Temp, L - 1) + else + Temp := ''; + Result := Temp; +end; + +function _(const szMsgId: string): string; +begin + Result:=gettext(szMsgid); +end; + +function gettext(const szMsgId: string): string; +begin + Result:=string(DefaultInstance.gettext(DefaultInstance.ansi2wide(szMsgId))); +end; + +function dgettext(const szDomain: string; const szMsgId: string): string; +begin + Result:=string(DefaultInstance.dgettext(szDomain,DefaultInstance.ansi2wide(szMsgId))); +end; + +procedure TranslateComponent(AnObject: TComponent); +begin + gnugettext.TranslateComponent(AnObject); +end; + +// for delphi 4 + +procedure FreeAndNil(var P); +begin + TObject(P).Free; + Pointer(P) := NIL; +end; + +function IncludeTrailingBackSlash(const Path: string): string; +begin + if (Path <> '') and + not(Path[Length(Path)] in [':', '\']) then + Result := Path + '\' + else + Result := Path; +end; + +function ExcludeTrailingBackslash(const Path: string): string; +var + Len: Integer; +begin + Len := Length(Path); + while (Len > 0) and (Path[Len] in ['/', '\']) do Dec(Len); + SetString(Result, PChar(Path), Len); +end; + +end. diff --git a/win32/gui-2/locale/de/LC_MESSAGES/default.po b/win32/gui-2/locale/de/LC_MESSAGES/default.po new file mode 100644 index 000000000..c0b8bc006 --- /dev/null +++ b/win32/gui-2/locale/de/LC_MESSAGES/default.po @@ -0,0 +1,473 @@ +# +msgid "" +msgstr "" +"Project-Id-Version: GPSBabel 1.2.6\n" +"POT-Creation-Date: 2005-08-12 14:50\n" +"PO-Revision-Date: 2005-09-22 23:49+0100\n" +"Last-Translator: Olaf Klein \n" +"Language-Team: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: dxgettext 1.2\n" +"X-Poedit-Language: German\n" +"X-Poedit-Country: GERMANY\n" + +#. frmAbout..Caption +#: about.dfm:5 +msgid "About" +msgstr "Über" + +#. frmAbout..Font.Name +#. frmAbout..pnClient..StaticText1..Font.Name +#. frmFilter..Font.Name +#. frmMain..Font.Name +#. frmMain..Panel2..lbWhat..Font.Name +#. frmReadme..Font.Name +#: about.dfm:12 +#: about.dfm:72 +#: filter.dfm:13 +#: main.dfm:11 +#: main.dfm:238 +#: readme.dfm:11 +msgid "MS Sans Serif" +msgstr "MS Sans Serif" + +#. frmAbout..pnClient..Caption +#: about.dfm:26 +msgid "... under construction" +msgstr "... in Bearbeitung" + +#. frmAbout..pnClient..StaticText1..Caption +#: about.dfm:68 +msgid "GPSBabelGUI-2:" +msgstr "GPSBabelGUI-2:" + +#. frmAbout..pnClient..StaticText2..Caption +#: about.dfm:82 +#, fuzzy +msgid "The frontend for gpsbabel command line program" +msgstr "Das Windows-Fontend für ..." + +#. frmFilter..Caption +#: filter.dfm:6 +msgid "Filter" +msgstr "Filter" + +#. frmFilter..gbTracks..Caption +#. frmMain..Panel2..cbTracks..Caption +#: filter.dfm:27 +#: main.dfm:393 +msgid "&Tracks" +msgstr "&Tracks" + +#. frmFilter..gbTracks..lbTimePlusMinus..Caption +#: filter.dfm:35 +msgid "by" +msgstr "um" + +#. frmFilter..gbTracks..lbTimeDays..Caption +#: filter.dfm:42 +msgid "day(s), " +msgstr "Tag(e)," + +#. frmFilter..gbTracks..lbTimeHours..Caption +#: filter.dfm:49 +msgid "hour(s), " +msgstr "Stunde(n)," + +#. frmFilter..gbTracks..lbTimeMinutes..Caption +#: filter.dfm:56 +msgid "minute(s)," +msgstr "Minute(n)," + +#. frmFilter..gbTracks..lbTimeSeconds..Caption +#: filter.dfm:63 +msgid "second(s)" +msgstr "Sekunde(n)" + +#. frmFilter..gbTracks..cbTrackTitle..Hint +#: filter.dfm:70 +msgid "Title for new tracks" +msgstr "Titel für neu erstellte Tracks" + +#. frmFilter..gbTracks..cbTrackTitle..Caption +#: filter.dfm:72 +msgid "Tit&le" +msgstr "Tite&l" + +#. frmFilter..gbTracks..edTrackTitle..Text +#: filter.dfm:84 +msgid "ACTIVE LOG # %Y%m%d" +msgstr "ACTIVE LOG # %Y%m%d" + +#. frmFilter..gbTracks..cbTrackSplit..Hint +#: filter.dfm:91 +msgid "Split track into several tracks depending on date of trackpoint" +msgstr "" + +#. frmFilter..gbTracks..cbTrackSplit..Caption +#: filter.dfm:92 +msgid "&Split" +msgstr "&Splitten" + +#. frmFilter..gbTracks..cbTrackTime..Hint +#: filter.dfm:100 +msgid "Shift all tracks" +msgstr "Tracks um ein Zeiintervall verschieben " + +#. frmFilter..gbTracks..cbTrackTime..Caption +#: filter.dfm:101 +msgid "&Move" +msgstr "Verschieben" + +#. frmFilter..gbTracks..cbTrackStart..Hint +#: filter.dfm:193 +msgid "Take only trackpoints starting at" +msgstr "beginne bei Zeitpunkt ..." + +#. frmFilter..gbTracks..cbTrackStart..Caption +#: filter.dfm:194 +msgid "Start at" +msgstr "Beginnend am" + +#. frmFilter..gbTracks..cbTrackStop..Caption +#: filter.dfm:234 +msgid "stop at" +msgstr "bis zum" + +#. frmFilter..gbTracks..cbTrackPack..Hint +#: filter.dfm:273 +msgid "Pack all tracks into one track (No duplicate timestamps)" +msgstr "Alle Tracks zu einem einzigen zusammenfassen (doppelte Zeitstempel unzulässig)" + +#. frmFilter..gbTracks..cbTrackPack..Caption +#: filter.dfm:274 +msgid "&Pack (or)" +msgstr "&Packen (oder)" + +#. frmFilter..gbTracks..cbTrackMerge..Hint +#: filter.dfm:283 +msgid "Merge all tracks into one track" +msgstr "" + +#. frmFilter..gbTracks..cbTrackMerge..Caption +#: filter.dfm:284 +msgid "Merge" +msgstr "Zusammenführen" + +#. frmFilter..gbRoutes..Caption +#: filter.dfm:295 +msgid "&Routes && Tracks" +msgstr "&Routen && Tracks" + +#. frmFilter..gbRoutes..lbRouteSimplifyCount..Caption +#: filter.dfm:303 +msgid "limit to" +msgstr "maximal" + +#. frmFilter..gbRoutes..lbRouteSimplifyText..Caption +#: filter.dfm:311 +msgid "Points" +msgstr "Punkte" + +#. frmFilter..gbRoutes..cbRouteSimplify..Hint +#: filter.dfm:318 +msgid "Simplify routes and tracks by limited number of points" +msgstr "Limitiert die Anzahl von Wegpunkten in Routen und Tracks" + +#. frmFilter..gbRoutes..cbRouteSimplify..Caption +#: filter.dfm:319 +msgid "Simplify" +msgstr "Vereinfachen" + +#. frmFilter..gbRoutes..edRoutesSimplifyMaxPoints..Hint +#: filter.dfm:328 +msgid "Upper limit of points for routes and tracks" +msgstr "Maximale Anzahl an Punkten innerhalb von Routen und Tracks" + +#. frmFilter..gbRoutes..edRoutesSimplifyMaxPoints..Text +#: filter.dfm:333 +msgid "50 " +msgstr "50 " + +#. frmFilter..gbRoutes..cbReverse..Hint +#: filter.dfm:352 +msgid "Reverse routes and tracks" +msgstr "Reihenfolge von Wegpunkten in Routen und Tracks umdrehen" + +#. frmFilter..gbRoutes..cbReverse..Caption +#: filter.dfm:353 +msgid "Reverse" +msgstr "Umdrehen" + +#. frmFilter..pnBottom..btnOK..Caption +#: filter.dfm:370 +msgid "OK" +msgstr "OK" + +#. frmFilter..pnBottom..BitBtn1..Caption +#: filter.dfm:406 +msgid "File based filters" +msgstr "Datei basierende Filter" + +#. frmFilter..gbWaypoints..Caption +#. frmMain..Panel2..cbWaypoints..Caption +#: filter.dfm:426 +#: main.dfm:373 +msgid "&Waypoints" +msgstr "&Wegpunkte" + +#. frmFilter..gbWaypoints..cbWayptMergeDupLoc..Hint +#: filter.dfm:452 +msgid "Merge waypoints with duplicate locations" +msgstr "Fasse Wegpunkte mit gleichen Koordinaten zusammen" + +#. frmFilter..gbWaypoints..cbWayptMergeDupLoc..Caption +#: filter.dfm:453 +msgid "locations" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptMergeDupNames..Hint +#: filter.dfm:462 +msgid "Merge waypoints with duplicate \"short name\"" +msgstr "Fasse Wegpunkte mit gleichem Namen zusammen" + +#. frmFilter..gbWaypoints..cbWayptMergeDupNames..Caption +#: filter.dfm:463 +msgid "\"short names\"" +msgstr "\"Kurznamen\"" + +#. frmFilter..gbWaypoints..cbWayptMergeDistance..Hint +#: filter.dfm:472 +#, fuzzy +msgid "Merge waypoints separated by less then" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptMergeDistance..Caption +#: filter.dfm:473 +msgid "Radius" +msgstr "Radius" + +#. frmFilter..gbWaypoints..cobWayptMergeDist....Items.Strings +#: filter.dfm:487 +msgid "Feet" +msgstr "Feet" + +#. frmFilter..gbWaypoints..cobWayptMergeDist....Items.Strings +#: filter.dfm:488 +#: filter.pas:163 +msgid "Miles" +msgstr "Miles" + +#. frmFilter..gbWaypoints..cbWayptSort..Hint +#: filter.dfm:505 +msgid "Sort waypoints by \"short name\" or by description" +msgstr "Sortiere Wegpunkte nach Name oder Beschreibung" + +#. frmFilter..gbWaypoints..cbWayptSort..Caption +#: filter.dfm:506 +msgid "Sort" +msgstr "Sortieren" + +#. frmFilter..gbWaypoints..cbWayptMergeDups..Hint +#: filter.dfm:514 +msgid "Merge duplicate waypoints" +msgstr "Entferne doppelte Wegpunkte" + +#. frmFilter..gbWaypoints..cbWayptMergeDups..Caption +#: filter.dfm:515 +msgid "Duplicatates" +msgstr "Duplikate" + +#. frmMain..Caption +#: main.dfm:6 +msgid "GPSBabelGUI-2" +msgstr "GPSBabelGUI-2" + +#. frmMain..Panel1..lbInputFile..Caption +#: main.dfm:78 +msgid "&Input file" +msgstr "Eingabe-Datei" + +#. frmMain..Panel1..lbOutputFile..Caption +#: main.dfm:86 +msgid "Out&put file" +msgstr "Ausgabe-Datei" + +#. frmMain..Panel1..lbInputFormat..Caption +#: main.dfm:94 +msgid "Input &format" +msgstr "Eingabe-Format" + +#. frmMain..Panel1..lbOutputFormat..Caption +#: main.dfm:101 +msgid "Output f&ormat" +msgstr "Ausgabe-Format" + +#. frmMain..Panel1..chbInputDevice..Caption +#. frmMain..Panel1..chbOutputDevice..Caption +#: main.dfm:150 +#: main.dfm:199 +msgid "Device" +msgstr "Gerät" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:162 +#: main.dfm:211 +msgid "USB" +msgstr "USB" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:163 +#: main.dfm:212 +msgid "COM1" +msgstr "COM1" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:164 +#: main.dfm:213 +msgid "COM2" +msgstr "COM2" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:165 +#: main.dfm:214 +msgid "COM3" +msgstr "COM3" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:166 +#: main.dfm:215 +msgid "COM4" +msgstr "COM4" + +#. frmMain..Panel2..lbWhat..Caption +#: main.dfm:234 +msgid "What ?" +msgstr "Was?" + +#. frmMain..Panel2..cbRoutes..Caption +#: main.dfm:384 +msgid "&Routes" +msgstr "&Routen" + +#. frmMain..Panel2..btnFilter..Caption +#. frmMain..ActionList1..acFilterSelect..Caption +#: main.dfm:404 +#: main.dfm:907 +msgid "&Filter" +msgstr "&Filter" + +#. frmMain..Panel2..btnProcess..Caption +#. frmMain..ActionList1..acConvert..Caption +#: main.dfm:428 +#: main.dfm:900 +msgid "let's go" +msgstr "und los" + +#. frmMain..memoOutput..Font.Name +#: main.dfm:455 +msgid "Fixedsys" +msgstr "Fixedsys" + +#. frmMain..stbMain......Text +#: main.dfm:473 +msgid "http://sourceforge.net/projects/gpsbabel" +msgstr "http://sourceforge.net/projects/gpsbabel" + +#. frmMain..OpenDialog..Filter +#: main.dfm:480 +msgid "Garmin Mapsource|*.gdb|Garmin Mapsource mps|*.mps|All files|*.*" +msgstr "Garmin Mapsource|*.gdb|Garmin Mapsource mps|*.mps|All files|*.*" + +#. frmMain..ActionList1..acConvert..Category +#. frmMain..ActionList1..acFilterSelect..Category +#: main.dfm:899 +#: main.dfm:906 +msgid "Babel" +msgstr "Babel" + +#. frmMain..ActionList1..acFileExit..Category +#: main.dfm:912 +msgid "File" +msgstr "Datei" + +#. frmMain..ActionList1..acFileExit..Caption +#: main.dfm:913 +msgid "E&xit" +msgstr "Beenden" + +#. frmMain..ActionList1..acHelpAbout..Category +#. frmMain..ActionList1..acHelpIntro..Category +#. frmMain..ActionList1..acHelpReadme..Category +#: main.dfm:918 +#: main.dfm:923 +#: main.dfm:927 +msgid "Help" +msgstr "Hilfe" + +#. frmMain..ActionList1..acHelpAbout..Caption +#: main.dfm:919 +msgid "&About" +msgstr "Über" + +#. frmMain..ActionList1..acHelpIntro..Caption +#: main.dfm:924 +msgid "&Intro" +msgstr "Einführung" + +#. frmMain..ActionList1..acHelpReadme..Caption +#. frmReadme..Caption +#: main.dfm:928 +#: readme.dfm:6 +msgid "GPSBabel README" +msgstr "GPSBabel README" + +#. frmMain..MainMenu1..mnuFile..Caption +#: main.dfm:937 +msgid "&File" +msgstr "&Datei" + +#. frmMain..MainMenu1..mnuHelp..Caption +#: main.dfm:943 +msgid "&Help" +msgstr "&Hilfe" + +#: main.pas:249 +msgid "All files|*.*" +msgstr "Alle Dateien|*.*" + +#: main.pas:338 +msgid "|All files|*.*" +msgstr "|Alle Dateien|*.*" + +#: main.pas:377 +msgid "File %s not found." +msgstr "Datei \"%s\" nicht gefunden." + +#: main.pas:394 +msgid "File \"%s\" exists ! Overwrite ?" +msgstr "Datei \"%s\" existiert bereits! Überschreiben?" + +#: main.pas:395 +msgid "Warning" +msgstr "Warnung" + +#: main.pas:420 +msgid "Could not run \"gpsbabel.exe\"!" +msgstr "Konnte \"gpsbabel.exe\" nicht ausführen!" + +#: main.pas:429 +msgid "Converted successfully from \"%s\" to \"%s\"." +msgstr "Erfolgreich konvertiert von \"%s\" zu \"%s\"." + +#: main.pas:430 +msgid "Success" +msgstr "Erfolg" + diff --git a/win32/gui-2/locale/fr/LC_MESSAGES/default.po b/win32/gui-2/locale/fr/LC_MESSAGES/default.po new file mode 100644 index 000000000..5cdaafa58 --- /dev/null +++ b/win32/gui-2/locale/fr/LC_MESSAGES/default.po @@ -0,0 +1,476 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# FIRST AUTHOR , YEAR. +# +msgid "" +msgstr "" +"Project-Id-Version: French version\n" +"POT-Creation-Date: 2005-09-22 23:44\n" +"PO-Revision-Date: 2005-09-24 22:45+0100\n" +"Last-Translator: Lilian Morinon \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: dxgettext 1.2\n" +"Language-Team: Utagawa VTT \n" +"X-Poedit-Language: French\n" +"X-Poedit-Country: FRANCE\n" +"X-Poedit-SourceCharset: utf-8\n" + +#. frmAbout..Caption +#: about.dfm:5 +msgid "About" +msgstr "A propos" + +#. frmAbout..Font.Name +#. frmAbout..pnClient..StaticText1..Font.Name +#. frmFilter..Font.Name +#. frmMain..Font.Name +#. frmMain..Panel2..lbWhat..Font.Name +#. frmReadme..Font.Name +#: about.dfm:12 +#: about.dfm:72 +#: filter.dfm:13 +#: main.dfm:11 +#: main.dfm:238 +#: readme.dfm:11 +msgid "MS Sans Serif" +msgstr "" + +#. frmAbout..pnClient..Caption +#: about.dfm:26 +msgid "... under construction" +msgstr "...en travaux" + +#. frmAbout..pnClient..StaticText1..Caption +#: about.dfm:68 +msgid "GPSBabelGUI-2:" +msgstr "" + +#. frmAbout..pnClient..StaticText2..Caption +#: about.dfm:82 +msgid "The frontend for gpsbabel command line program" +msgstr "L'interface graphique de gpsbabel" + +#. frmFilter..Caption +#: filter.dfm:6 +msgid "Filter" +msgstr "Filtre" + +#. frmFilter..gbTracks..Caption +#. frmMain..Panel2..cbTracks..Caption +#: filter.dfm:27 +#: main.dfm:393 +msgid "&Tracks" +msgstr "&Traces" + +#. frmFilter..gbTracks..lbTimePlusMinus..Caption +#: filter.dfm:35 +msgid "by" +msgstr "par" + +#. frmFilter..gbTracks..lbTimeDays..Caption +#: filter.dfm:42 +msgid "day(s), " +msgstr "jour(s)," + +#. frmFilter..gbTracks..lbTimeHours..Caption +#: filter.dfm:49 +msgid "hour(s), " +msgstr "heure(s)" + +#. frmFilter..gbTracks..lbTimeMinutes..Caption +#: filter.dfm:56 +msgid "minute(s)," +msgstr "minute(s)" + +#. frmFilter..gbTracks..lbTimeSeconds..Caption +#: filter.dfm:63 +msgid "second(s)" +msgstr "seconde(s)" + +#. frmFilter..gbTracks..cbTrackTitle..Hint +#: filter.dfm:70 +msgid "Title for new tracks" +msgstr "Titres des nouvelles traces" + +#. frmFilter..gbTracks..cbTrackTitle..Caption +#: filter.dfm:72 +msgid "Tit&le" +msgstr "Tit&re" + +#. frmFilter..gbTracks..edTrackTitle..Text +#: filter.dfm:84 +msgid "ACTIVE LOG # %Y%m%d" +msgstr "" + +#. frmFilter..gbTracks..cbTrackSplit..Hint +#: filter.dfm:91 +msgid "Split track into several tracks depending on date of trackpoint" +msgstr "Scinder la trace en plusieurs traces en fonction de la date des points" + +#. frmFilter..gbTracks..cbTrackSplit..Caption +#: filter.dfm:92 +msgid "&Split" +msgstr "&Scinder" + +#. frmFilter..gbTracks..cbTrackTime..Hint +#: filter.dfm:100 +msgid "Shift all tracks" +msgstr "Inverser toutes les traces" + +#. frmFilter..gbTracks..cbTrackTime..Caption +#: filter.dfm:101 +msgid "&Move" +msgstr "&Déplacer" + +#. frmFilter..gbTracks..cbTrackStart..Hint +#: filter.dfm:193 +msgid "Take only trackpoints starting at" +msgstr "Utiliser seulement les points commençant à" + +#. frmFilter..gbTracks..cbTrackStart..Caption +#: filter.dfm:194 +msgid "Start at" +msgstr "Commencer à" + +#. frmFilter..gbTracks..cbTrackStop..Caption +#: filter.dfm:234 +msgid "stop at" +msgstr "Arrêter à" + +#. frmFilter..gbTracks..cbTrackPack..Hint +#: filter.dfm:273 +msgid "Pack all tracks into one track (No duplicate timestamps)" +msgstr "Fusionner toutes les traces en une seule (pas de duplication de l'horodatage)" + +#. frmFilter..gbTracks..cbTrackPack..Caption +#: filter.dfm:274 +msgid "&Pack (or)" +msgstr "&Fusionner (ou)" + +#. frmFilter..gbTracks..cbTrackMerge..Hint +#: filter.dfm:283 +msgid "Merge all tracks into one track" +msgstr "Fusionner toutes les traces en une seule" + +#. frmFilter..gbTracks..cbTrackMerge..Caption +#: filter.dfm:284 +msgid "Merge" +msgstr "Fusionner" + +#. frmFilter..gbRoutes..Caption +#: filter.dfm:295 +msgid "&Routes && Tracks" +msgstr "&Routes && Traces" + +#. frmFilter..gbRoutes..lbRouteSimplifyCount..Caption +#: filter.dfm:303 +msgid "limit to" +msgstr "limiter à" + +#. frmFilter..gbRoutes..lbRouteSimplifyText..Caption +#: filter.dfm:311 +msgid "Points" +msgstr "" + +#. frmFilter..gbRoutes..cbRouteSimplify..Hint +#: filter.dfm:318 +msgid "Simplify routes and tracks by limited number of points" +msgstr "Simplifier les routes et traces en limitant le nombre de points" + +#. frmFilter..gbRoutes..cbRouteSimplify..Caption +#: filter.dfm:319 +msgid "Simplify" +msgstr "Simplifier" + +#. frmFilter..gbRoutes..edRoutesSimplifyMaxPoints..Hint +#: filter.dfm:328 +msgid "Upper limit of points for routes and tracks" +msgstr "Limite maximum du nombre de points pour les routes et traces" + +#. frmFilter..gbRoutes..edRoutesSimplifyMaxPoints..Text +#: filter.dfm:333 +msgid "50 " +msgstr "" + +#. frmFilter..gbRoutes..cbReverse..Hint +#: filter.dfm:352 +msgid "Reverse routes and tracks" +msgstr "Inverser les routes et les traces" + +#. frmFilter..gbRoutes..cbReverse..Caption +#: filter.dfm:353 +msgid "Reverse" +msgstr "Inverser" + +#. frmFilter..pnBottom..btnOK..Caption +#: filter.dfm:370 +msgid "OK" +msgstr "" + +#. frmFilter..pnBottom..BitBtn1..Caption +#: filter.dfm:406 +msgid "File based filters" +msgstr "Filtres de fichiers" + +#. frmFilter..gbWaypoints..Caption +#. frmMain..Panel2..cbWaypoints..Caption +#: filter.dfm:426 +#: main.dfm:373 +msgid "&Waypoints" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptMergeDupLoc..Hint +#: filter.dfm:452 +msgid "Merge waypoints with duplicate locations" +msgstr "Fusionner les waypoints avec les positions en doublon" + +#. frmFilter..gbWaypoints..cbWayptMergeDupLoc..Caption +#: filter.dfm:453 +msgid "locations" +msgstr "positions" + +#. frmFilter..gbWaypoints..cbWayptMergeDupNames..Hint +#: filter.dfm:462 +msgid "Merge waypoints with duplicate \"short name\"" +msgstr "Fusionner les waypoints avec les doublons \"short name\"" + +#. frmFilter..gbWaypoints..cbWayptMergeDupNames..Caption +#: filter.dfm:463 +msgid "\"short names\"" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptMergeDistance..Hint +#: filter.dfm:472 +msgid "Merge waypoints separated by less then" +msgstr "Fusionner les waypoints séparé par moins de" + +#. frmFilter..gbWaypoints..cbWayptMergeDistance..Caption +#: filter.dfm:473 +msgid "Radius" +msgstr "Rayon" + +#. frmFilter..gbWaypoints..cobWayptMergeDist....Items.Strings +#: filter.dfm:487 +msgid "Feet" +msgstr "" + +#. frmFilter..gbWaypoints..cobWayptMergeDist....Items.Strings +#: filter.dfm:488 +#: filter.pas:163 +msgid "Miles" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptSort..Hint +#: filter.dfm:505 +msgid "Sort waypoints by \"short name\" or by description" +msgstr "Trier les waypoints par \"short name\" ou par description" + +#. frmFilter..gbWaypoints..cbWayptSort..Caption +#: filter.dfm:506 +msgid "Sort" +msgstr "Trier" + +#. frmFilter..gbWaypoints..cbWayptMergeDups..Hint +#: filter.dfm:514 +msgid "Merge duplicate waypoints" +msgstr "Fusionner les waypoints identiques" + +#. frmFilter..gbWaypoints..cbWayptMergeDups..Caption +#: filter.dfm:515 +msgid "Duplicatates" +msgstr "Doublons" + +#. frmMain..Caption +#: main.dfm:6 +msgid "GPSBabelGUI-2" +msgstr "" + +#. frmMain..Panel1..lbInputFile..Caption +#: main.dfm:78 +msgid "&Input file" +msgstr "Fichier &source" + +#. frmMain..Panel1..lbOutputFile..Caption +#: main.dfm:86 +msgid "Out&put file" +msgstr "Fichier &cible" + +#. frmMain..Panel1..lbInputFormat..Caption +#: main.dfm:94 +msgid "Input &format" +msgstr "Format sou&rce" + +#. frmMain..Panel1..lbOutputFormat..Caption +#: main.dfm:101 +msgid "Output f&ormat" +msgstr "Format ci&ble" + +#. frmMain..Panel1..chbInputDevice..Caption +#. frmMain..Panel1..chbOutputDevice..Caption +#: main.dfm:150 +#: main.dfm:199 +msgid "Device" +msgstr "Périphérique" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:162 +#: main.dfm:211 +msgid "USB" +msgstr "" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:163 +#: main.dfm:212 +msgid "COM1" +msgstr "" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:164 +#: main.dfm:213 +msgid "COM2" +msgstr "" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:165 +#: main.dfm:214 +msgid "COM3" +msgstr "" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:166 +#: main.dfm:215 +msgid "COM4" +msgstr "" + +#. frmMain..Panel2..lbWhat..Caption +#: main.dfm:234 +msgid "What ?" +msgstr "Quoi ?" + +#. frmMain..Panel2..cbRoutes..Caption +#: main.dfm:384 +msgid "&Routes" +msgstr "" + +#. frmMain..Panel2..btnFilter..Caption +#. frmMain..ActionList1..acFilterSelect..Caption +#: main.dfm:404 +#: main.dfm:907 +msgid "&Filter" +msgstr "&Filtre" + +#. frmMain..Panel2..btnProcess..Caption +#. frmMain..ActionList1..acConvert..Caption +#: main.dfm:428 +#: main.dfm:900 +msgid "let's go" +msgstr "Lancer" + +#. frmMain..memoOutput..Font.Name +#: main.dfm:455 +msgid "Fixedsys" +msgstr "" + +#. frmMain..stbMain......Text +#: main.dfm:473 +msgid "http://sourceforge.net/projects/gpsbabel" +msgstr "" + +#. frmMain..OpenDialog..Filter +#: main.dfm:480 +msgid "Garmin Mapsource|*.gdb|Garmin Mapsource mps|*.mps|All files|*.*" +msgstr "Garmin Mapsource|*.gdb|Garmin Mapsource mps|*.mps|Tous les fichiers|*.*" + +#. frmMain..ActionList1..acConvert..Category +#. frmMain..ActionList1..acFilterSelect..Category +#: main.dfm:899 +#: main.dfm:906 +msgid "Babel" +msgstr "" + +#. frmMain..ActionList1..acFileExit..Category +#: main.dfm:912 +msgid "File" +msgstr "Fichier" + +#. frmMain..ActionList1..acFileExit..Caption +#: main.dfm:913 +msgid "E&xit" +msgstr "F&ermer" + +#. frmMain..ActionList1..acHelpAbout..Category +#. frmMain..ActionList1..acHelpIntro..Category +#. frmMain..ActionList1..acHelpReadme..Category +#: main.dfm:918 +#: main.dfm:923 +#: main.dfm:927 +msgid "Help" +msgstr "Aide" + +#. frmMain..ActionList1..acHelpAbout..Caption +#: main.dfm:919 +msgid "&About" +msgstr "&A propos" + +#. frmMain..ActionList1..acHelpIntro..Caption +#: main.dfm:924 +msgid "&Intro" +msgstr "&Introduction" + +#. frmMain..ActionList1..acHelpReadme..Caption +#. frmReadme..Caption +#: main.dfm:928 +#: readme.dfm:6 +msgid "GPSBabel README" +msgstr "GPSBabel README" + +#. frmMain..MainMenu1..mnuFile..Caption +#: main.dfm:937 +msgid "&File" +msgstr "&Fichier" + +#. frmMain..MainMenu1..mnuHelp..Caption +#: main.dfm:943 +msgid "&Help" +msgstr "&Aide" + +#: main.pas:249 +msgid "All files|*.*" +msgstr "Tous les fichiers|*.*" + +#: main.pas:338 +msgid "|All files|*.*" +msgstr "|Tous les fichiers|*.*" + +#: main.pas:377 +msgid "File %s not found." +msgstr "Fichier%s non trouvé." + +#: main.pas:394 +msgid "File \"%s\" exists ! Overwrite ?" +msgstr "Le fichier \"%s\" existe déjà ! Ecraser ?" + +#: main.pas:395 +msgid "Warning" +msgstr "Attention" + +#: main.pas:420 +msgid "Could not run \"gpsbabel.exe\"!" +msgstr "Impossible d'éxécuter \"gpsbabel.exe\"!" + +#: main.pas:429 +msgid "Converted successfully from \"%s\" to \"%s\"." +msgstr "Conversion de \"%s\" à \"%s\" réussie." + +#: main.pas:430 +msgid "Success" +msgstr "Succès" + diff --git a/win32/gui-2/main.dfm b/win32/gui-2/main.dfm new file mode 100644 index 0000000000000000000000000000000000000000..32911004ebee6c5bbc7c0a586dd99ec369bef994 GIT binary patch literal 22046 zcmeHPU2GfImA>Ri9Ey}grA`WL5n$C8tEMSpOP)p8)In%TmJ^|orCLn<(1&zLjU}%6 zSI)>|_ixyzWU&jRg&zvF1-5A4iUn%G5Bne>A^L+B-C&c4KJ+avP_%EZ3U)ykC_H=4 zy>n*nT#~XJJKZqwwJy&+KlhyT-Fs&^GuJ~u!-{9mudOYvo@4VflP@z?+&DX*E?#Wa z*33#>59rv7)b#YIlF1r?b%JMRk(>qhVJtXMMWa*etg!tG;a29jm3U*O#je+tMLU ztHzs?f#?gnR_m%h9m+YM1||2aLwxAK+o|>X=1#-a(T)~#xae=hLxPBI+sB#pKgj`n}B@x^LoyRMI$Rj^1G%@RkHWNfmy*|e;! zrCrBq)H8Nzy=m3YR;remz~Ax-OzL9(k{=DGFZoe@5mIWj?CiLC2|ViNrSmwiEc1Nz zYIEoK8PhQ{Ur8`_8S2s+eqy-{^$Do6P-mbf*cg2BhM@3?a;&1X8G}F8ZVLjR&}5$H zu{Ym*6BIuGW4@0qsPGR(@L@o?VHl?j-!MGG=$*RZe)YfHuinUeeh>a^<2rO;S;KI7 zF^qZWqPahl@SGm4d063u6z@33>*@g84sUideTyZ*h{_PS?a4`R=;){6h z%~ngR_2#Yi0@!HJ4T zn5>r8cbx$t>cQfg?+-BvJ?5axfEbh3R^%=WGDR@p6lyx+q$q$q6-4=Lf0QYKW9}mF z6#AMD6Yg_%A#irO-`TXtYWCt>;BBI~+^CfrON}d2MGb4Y$7B*sVLsnarwV)#w`{I?E^U`)0?iZ(DknCnFff zqTHs-G&@mpDLJ|G?^klkVabgbSGFonY@X$W>>!~pA9=K*0nwtEACcD)jf)5^FJn1! z`aUAFDDorHQ9^-XLUye3C0H!e;v++lF|M=O9SM9hHib*iKECO+D)ntUkLk z6B7RTHSkFhoL>WLaK$TbIl_zJMG z;fG%)7|&1BfiM#terP*eco4TNe?HnROGe~>7QT7m2#R0KyG@6Gv#oz#jLZg4KNX}u zN$F4OD|Hi&z^(KL>*AeX#TbU~cd<1eT;9N?QUL_>=~wxsUEYRk>w;mVUuC)r7uR;d z^?bWK|61-RKhc|TZS5L)uh*S#!^PDB@Oi_v^SwgaV?UhDxta%peBSrcnaq=)$mp7f z7xuR2<#L%H|1c-hXDf^x?dY^t@(T zjwK(i+6{3xPseNa;qf|}$1BWh?0BV#r33ci#E#~PIODV~#SU0Me!xEbf*s9y&BDCK z57=O0>41GWu_H6F(fxF`T)JRhZ8j=(#}=2vX6$NyoxWb9o9WD4*hA;H<<{23_@)Ef z0kAz$3MA1z0}Jn+W~5lreN%9&mM)jhH+CIMWTE|3oHXdB;_3c0^f_T4MM{K`;HF(D z2ZbrN%<`om%#3)De`pwCABBk?8$%eO48rKerHTXlGZQ7)qp4J32ZRr)_NDlC!50Y3 z$5M-Bv2S9Qh5e>gwaQNTc#HNA(k49nfSrgM3-77)Ing7^OZ!0Hr@&RaR0=-qJHW@@ zwY&}=hU;~`EjH-NRO0t3v@9~P zEH+w=vSkOW?~VAn*r0Xs540{O%rZPYzHGIQv?S71%lVW&yWNP^#MlRDP3-dmL(Yq5 z>@yU=t^rPH7x?V{{&nQ-t^xO+1~B`$5#_;zxi<3I>si$2y}WGzzn=vUz;h4CGw^`C z3wNuYaqAYFzI6*)c<+n+bQ=V~+prUb{LQw|=ksyVb=hg;zGqO!#CEMcotWSovNeFGryWylBL{czCs|?)w|Y}c zJC4)*+=&w~u*bKXb_q9XjyGD{vrhyHyRq9UTd;4jZ5^*$&WUEL@h@;%wNH?B@Q5^d z5_UQ_E460T;@idWs3=>+t-v!Cv)b6sL{0wOH<1#j+*ILtvsJ6qXV=W82=%omk8f|4 zzNU(2YfT$e__Gy zjj+027p?{T?>1D1*^z!!X@mC+1m})3J|wTKBSkRIzi!!Ma8~Dn7!6`02REb01+BeaLDwsfAb}S&yK}xf^IlII$zO zRVwS00E7prFzcUNvcdS&R@}U27X6XW!^U8!os3lgh>wGu8QLm^VxySaavl^HscgfU z`}~l7%du&mi4L+0L#y~vK{7HT{s{Of59~^D$qmWm@sV}+(k9>Um4>loY=n;}8V%Bi zoufG?5#gu2NKTaW$m2NRYdu(Lu868K*$(^4evrp<)N#eWVL1$+szY8WY97c_9h8r3 zPgsSWIERr;#ZPkVk45$)^THQ5;UCmbrsM++RESZ}e%%20u{Zm;|9@&#E;YIw^Mv8^jJW(zT zK4d>ALS8Paevl2yRBSSSSx0R-2Kl6XDF>v3;;Z&DUbT(3gj>!DU0a7?$IdD~ z;>j`bL`hC`7#_k;c0`BSlRly$-wUO_9|n3axYcvP`+vD~nV@gVMW&S3 z;j!Cb29>Z5qUdNqAzVnY42wf{16+h6y53Rq4-JMi$ez@g165f!EH{ol_`!vtV?fRo zD&xX7mO*i3JH}}EIJ>th)hs78s$3BFOV}+rPQOF4O zWFrz3pXd_{#U);71zuSux5-A(HlK1a4%}h?8i;oYIrK^KWf~d;4YE_^$YVdmr{;(J zFzn=q`k)Vrk1~>zf0?Jg5f%8sg(%oiYh)a2pM#*qJ^_TyQ$hcC-%W;div3{l)kH_}7m1i<@tEe|FH(e)aQLf7fO}zmGjS+FQ>u zcIu9x3muS8vcxC9+0lOfIMec{I@+(FWjfQjK8N&w9>4Q%{_7p>?Z^Fh{da*r>$?~S z;=Rjhg2x3*-~Zb`cJ%-5-Yy(`s-yp+do%ZkY)Aifx1;}dyraL>ZEM%QDd>Nekg~*Q zejw&+XZ~JM7&~% zuZv`(=0b|UI%4a6uaKPPZ>7A=m>%?u-a$(*!#keajn>uFIR9bF@Lk04#k1%qQ@H!p z`j&MiIX1CgU%6tH;pI+!CVZhSkVJ8& '') then + cbInputDevice.Text := s + else + cbInputDevice.ItemIndex := 0; + + s := ReadProfile(cbOutputDevice.Tag); + if (s <> '') then + cbOutputDevice.Text := s + else + cbOutputDevice.ItemIndex := 0; + + FFirstShow := True; + + FixAlign(sbOpenFile, 8); + FixAlign(sbSaveFile, 8); + FixAlign(cbInputFormat, 8); + FixAlign(cbInputFormatDevice, 8); + FixAlign(cbOutputFormat, 8); + FixAlign(btnProcess, 8); + FixAlign(btnFilter, 16, btnProcess); + FixAlign(edInputFile, 8, sbOpenFile); + FixAlign(edOutputFile, 8, sbSaveFile); + FixAlign(cbOutputFormatDevice, 8); +end; + +procedure TfrmMain.LoadFileFormats; +var + l: TStrings; +begin + l := TStringList.Create; + try + gpsbabel('-^2', l); + FCaps.List := l; + InitCombo(cbInputFormat, True, False); + InitCombo(cbOutputFormat, False, False); + InitCombo(cbInputFormatDevice, False, True); + InitCombo(cbOutputFormatDevice, True, True); + finally + l.Free; + end; +end; + +procedure TfrmMain.FormShow(Sender: TObject); +begin + if not(FFirstShow) then Exit; + FFirstShow := False; + PostMessage(SELF.Handle, WM_STARTUP, 0, 0); // keep sure our window is visible +end; + +procedure TfrmMain.WMSTARTUP(var Msg: TMessage); +begin + LoadVersion; + LoadFileFormats; + + // README form + + acHelpReadme.Enabled := (frmReadme.Memo.Lines.Count > 0); +end; + +procedure TfrmMain.InitCombo(Target: TComboBox; ForRead, ForDevice: Boolean); +var + i: Integer; + OK: Boolean; + s: string; +begin + for i := 0 to FCaps.Count - 1 do + begin + if (ForDevice and not(FCaps.IsDevice(i))) then Continue; + if not(ForDevice) and not FCaps.IsFile(i) then Continue; + + if (ForRead) then + OK := FCaps.CanReadAny(i) + else + OK := FCaps.CanWriteAny(i); + if OK then + Target.Items.Add(FCaps.GetDescr(i)); + end; + + s := ReadProfile(Target.Tag); + + i := FCaps.GetCaps(s); + if (i > 0) then + Target.Text := s; + ComboChange(Target); +end; + +procedure TfrmMain.OpenButtonClick(Sender: TObject); +var + s: string; +begin + OpenDialog.Filter := ''; + OpenDialog.DefaultExt := '*.*'; + + if (cbInputFormat.Text <> '') then + s := cbInputFormat.Text + '|*.' + FCaps.GetExt(cbInputFormat.Text) + '|'; + s := s + _('All files|*.*'); + + OpenDialog.Filter := s; + if not SELF.OpenDialog.Execute then Exit; + + edInputFile.Text := OpenDialog.FileName; +end; + +procedure TfrmMain.ComboChange(Sender: TObject); +var + caps: Integer; + ext: string; +begin + caps := FCaps.GetCaps(TComboBox(Sender).Text); + ext := FCaps.GetExt(TComboBox(Sender).Text); + + if (Sender = cbInputFormat) then + begin + wptInputOK.Enabled := (caps and 1 <> 0); + trkInputOK.Enabled := (caps and 4 <> 0); + rteInputOK.Enabled := (caps and 16 <> 0); + end + else + begin + wptOutputOK.Enabled := (caps and 2 <> 0); + trkOutputOK.Enabled := (caps and 8 <> 0); + rteOutputOK.Enabled := (caps and 32 <> 0); + if (edOutputFile.Text <> '') and (ext <> '') then + begin + edOutputFile.Text := SysUtils.ChangeFileExt(edOutputFile.Text, '.' + ext); + end; + end; + CheckInput; +end; + +procedure TfrmMain.edInputFileChange(Sender: TObject); +begin + CheckInput; +end; + +procedure TfrmMain.CheckInput; +begin + acConvert.Enabled := + ((chbInputDevice.Checked and + (cbInputDevice.Text <> '') and + (cbInputFormatDevice.Text <> '')) + or + (not(chbInputDevice.Checked) and + (edInputFile.Text <> '') and + (cbInputFormat.Text <> ''))) + and + ((chbOutputDevice.Checked and + (cbOutputDevice.Text <> '') and + (cbOutputFormatDevice.Text <> '')) + or + (not(chbOutputDevice.Checked) and + (edOutputFile.Text <> '') and + (cbOutputFormat.Text <> ''))); +end; + +procedure TfrmMain.edOutputFileChange(Sender: TObject); +begin + CheckInput; +end; + +procedure TfrmMain.cbWaypointsClick(Sender: TObject); +begin + CheckInput; +end; + +procedure TfrmMain.cbRoutesClick(Sender: TObject); +begin + CheckInput; +end; + +procedure TfrmMain.cbTracksClick(Sender: TObject); +begin + CheckInput; +end; + +procedure TfrmMain.sbSaveFileClick(Sender: TObject); +var + s: string; +begin + SaveDialog.Filter := ''; + SaveDialog.DefaultExt := '*.*'; + + if (cbOutputFormat.Text <> '') then + s := cbOutputFormat.Text + '|*.' + FCaps.GetExt(cbOutputFormat.Text) + '|'; + s := s + _('|All files|*.*'); + + SaveDialog.Filter := s; + if not SELF.SaveDialog.Execute then Exit; + + edOutputFile.Text := SaveDialog.FileName; +end; + +procedure TfrmMain.acConvertExecute(Sender: TObject); +var + cmdline: string; + list: TStrings; + CSave: TCursor; + str: TStream; + s: string; + i: Integer; + IFormat, OFormat: string; + +begin + cmdline := ''; + + if chbInputDevice.Checked then + IFormat := FCaps.GetName(cbInputFormatDevice.Text) + else + IFormat := FCaps.GetName(cbInputFormat.Text); + if chbOutputDevice.Checked then + OFormat := FCaps.GetName(cbOutputFormatDevice.Text) + else + OFormat := FCaps.GetName(cbOutputFormat.Text); + + if cbWaypoints.Checked then cmdline := cmdline + ' -w'; + if cbRoutes.Checked then cmdline := cmdline + ' -r'; + if cbTracks.Checked then cmdline := cmdline + ' -t'; + + if chbInputDevice.Checked then + s := SysUtils.AnsiLowerCase(cbInputDevice.Text) + ':' + else begin + s := edInputFile.Text; + if not(FileExists(s)) then + raise eGPSBabelError.CreateFmt(_('File %s not found.'), [s]); + s := '"' + s + '"'; + end; + + cmdline := Format('%s -i %s -f %s', + [ cmdline, IFormat, s]); + + cmdline := cmdline + frmFilter.CmdLine; + + if (chbOutputDevice.Checked) then + s := cbOutputDevice.Text + ':' + else begin + s := edOutputFile.Text; + + if FileExists(s) then + begin + if (Windows.MessageBox(SELF.Handle, + PChar(Format(_('File "%s" exists ! Overwrite ?'), [s])), + PChar(_('Warning')), MB_YESNO) <> IDYES) then Exit; + end + else + begin + str := TFileStream.Create(s, fmCreate); + str.Free; + end; + s := '"' + s + '"'; + end; + + cmdline := Format('%s -o %s -F %s', + [ cmdline, OFormat, s]); + + while (cmdline[1] = ' ') do System.Delete(cmdline, 1, 1); + + AddToOutput('gpsbabel.exe ' + cmdline); + + list := TStringList.Create; + try + CSave := Cursor; + Cursor := crHourGlass; + Application.ProcessMessages; + Sleep(50); + + if not gpsbabel(cmdline, list) then + raise eGPSBabelError.Create(_('Could not run "gpsbabel.exe"!')); + + if (list.Count > 0) then + begin + AddToOutput(''); + AddToOutput(string(list.GetText)); + end; + + MessageBox(SELF.Handle, + PChar(Format(_('Converted successfully from "%s" to "%s".'), [IFormat, OFormat])), + PChar(_('Success')), MB_OK); + + finally + + Cursor := CSave; + list.Free; + + end; +end; + +procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + CanClose := True; +end; + +procedure TfrmMain.acFilterSelectExecute(Sender: TObject); +begin + if not(frmFilter.ShowModal = mrOk) then Exit; +end; + +procedure TfrmMain.AddToOutput(const Str: string); +begin + memoOutput.Lines.Add(Str); +end; + +procedure TfrmMain.AddToOutputFmt(const Format: string; + const Args: array of const); +begin + AddToOutput(SysUtils.Format(Format, Args)); +end; + +procedure TfrmMain.acFileExitExecute(Sender: TObject); +begin + PostMessage(SELF.Handle, WM_CLOSE, 0, 0); +end; + +procedure TfrmMain.LoadVersion; +var + l: TStrings; + i: Integer; + s: string; +begin + l := TStringList.Create; + try + if not gpsbabel('-V', l) then Exit; + + for i := 0 to l.Count - 1 do + begin + s := Trim(l.Strings[i]); + if (Copy(AnsiUpperCase(s), 1, 8) = 'GPSBABEL') then + begin + stbMain.Panels[0].Text := s; + stbMain.Panels[0].Width := stbMain.Canvas.TextWidth(s) + 32; + end; + end; + + finally + l.Free; + end; +end; + +procedure TfrmMain.acHelpAboutExecute(Sender: TObject); +begin + frmAbout.ShowModal; +end; + +procedure TfrmMain.chbInputDeviceClick(Sender: TObject); +begin + if not(Sender is TCheckBox) then Exit; + + if TCheckBox(Sender).Checked then + begin + edInputFile.Visible := False; + sbOpenFile.Visible := False; + cbInputDevice.Visible := True; + cbInputFormatDevice.Visible := True; + end + else + begin + cbInputFormatDevice.Visible := False; + cbInputDevice.Visible := False; + edInputFile.Visible := True; + sbOpenFile.Visible := True; + end; + CheckInput; +end; + +procedure TfrmMain.StoreProfiles; +var + s: string; +begin + s := SysUtils.ExtractFilePath(edInputFile.Text); + if (s <> '') then + StoreProfile(OpenDialog.Tag, s); + s := SysUtils.ExtractFilePath(edOutputFile.Text); + if (s <> '') then + StoreProfile(SaveDialog.Tag, s); + StoreProfile(cbInputFormat.Tag, cbInputFormat.Text); + StoreProfile(cbOutputFormat.Tag, cbOutputFormat.Text); + StoreProfile(cbInputDevice.Tag, cbInputDevice.Text); + StoreProfile(cbInputFormatDevice.Tag, cbInputFormatDevice.Text); + StoreProfile(cbOutputDevice.Tag, cbOutputDevice.Text); + StoreProfile(cbOutputFormatDevice.Tag, cbOutputFormatDevice.Text); +end; + +procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); +begin + StoreProfiles; +end; + +procedure TfrmMain.chbOutputDeviceClick(Sender: TObject); +begin + if not(Sender is TCheckBox) then Exit; + + if TCheckBox(Sender).Checked then + begin + edOutputFile.Visible := False; + sbSaveFile.Visible := False; + cbOutputFormatDevice.Visible := True; + cbOutputDevice.Visible := True; + end + else + begin + cbOutputDevice.Visible := False; + cbOutputFormatDevice.Visible := False; + sbSaveFile.Visible := True; + edOutputFile.Visible := True; + end; + CheckInput; +end; + +procedure TfrmMain.acHelpReadmeExecute(Sender: TObject); +begin + frmReadme.ShowModal; +end; + +end. + \ No newline at end of file diff --git a/win32/gui-2/readme.dfm b/win32/gui-2/readme.dfm new file mode 100644 index 0000000000000000000000000000000000000000..efc9d171fc4eb6f0275067f2a29548a688a31f40 GIT binary patch literal 652 zcmYLH%W|7A6cu0)U_0reo9w*kx|4o_!FH2L2n?vruC0u(V~vI65lU+B`yKt9{!!Ph zK#aZ7W3KKwN9WvsF(RunE0^;{wnVq@jxIu^Slz~CtC|w%rh({u8a={Rd*2+7$b)y| z_|I&kciww9xC8dG)7~Ekr}Uti6v6f9qDtr*_{>84spL}OsOE_lD_X;3C58T&?x<=( zmjZ(>ZVhqD^+kOS5SxtFJ=(_)w2@VCMpaOW%ub=w3EVE~LY+7e( z_rrxbky^_pPT&oA{%V}S!TRk<3b>#<2$O_qlODF4h4+5<)8JwY@9u|LaBuM3_##z1 d_UYdI9n*c;4GFqHqS1rN6_3{Y{K1Gv{{h~w#`ORI literal 0 HcmV?d00001 diff --git a/win32/gui-2/readme.pas b/win32/gui-2/readme.pas new file mode 100644 index 000000000..d4b1a6b50 --- /dev/null +++ b/win32/gui-2/readme.pas @@ -0,0 +1,63 @@ +unit readme; + +{ + Copyright (C) 2005 Olaf Klein, o.k.klein@t-online.de + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111 USA +} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ExtCtrls, StdCtrls, Buttons; + +type + TfrmReadme = class(TForm) + Memo: TMemo; + Panel1: TPanel; + BitBtn1: TBitBtn; + procedure FormDestroy(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + { Private declarations } + FStr: TStream; + public + { Public declarations } + end; + +var + frmReadme: TfrmReadme; + +implementation + +{$R *.DFM} + +procedure TfrmReadme.FormDestroy(Sender: TObject); +begin + FStr.Free; +end; + +procedure TfrmReadme.FormCreate(Sender: TObject); +begin + try + FStr := TFileStream.Create('README', fmOpenRead); + Memo.Lines.LoadFromStream(FStr); + except + FStr := nil; + end; +end; + +end. diff --git a/win32/gui-2/template.po b/win32/gui-2/template.po new file mode 100644 index 000000000..fe5634cc6 --- /dev/null +++ b/win32/gui-2/template.po @@ -0,0 +1,481 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# FIRST AUTHOR , YEAR. +# +msgid "" +msgstr "" +"Project-Id-Version: PACKAGE VERSION\n" +"POT-Creation-Date: 2005-09-22 23:44\n" +"PO-Revision-Date: 2005-09-22 23:44\n" +"Last-Translator: Somebody \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: dxgettext 1.2\n" + +#. frmAbout..Caption +#: about.dfm:5 +msgid "About" +msgstr "" + +#. frmAbout..Font.Name +#: about.dfm:12 +#. frmAbout..pnClient..StaticText1..Font.Name +#: about.dfm:72 +#. frmFilter..Font.Name +#: filter.dfm:13 +#. frmMain..Font.Name +#: main.dfm:11 +#. frmMain..Panel2..lbWhat..Font.Name +#: main.dfm:238 +#. frmReadme..Font.Name +#: readme.dfm:11 +msgid "MS Sans Serif" +msgstr "" + +#. frmAbout..pnClient..Caption +#: about.dfm:26 +msgid "... under construction" +msgstr "" + +#. frmAbout..pnClient..StaticText1..Caption +#: about.dfm:68 +msgid "GPSBabelGUI-2:" +msgstr "" + +#. frmAbout..pnClient..StaticText2..Caption +#: about.dfm:82 +msgid "The frontend for gpsbabel command line " +"program" +msgstr "" + +#. frmFilter..Caption +#: filter.dfm:6 +msgid "Filter" +msgstr "" + +#. frmFilter..gbTracks..Caption +#: filter.dfm:27 +#. frmMain..Panel2..cbTracks..Caption +#: main.dfm:393 +msgid "&Tracks" +msgstr "" + +#. frmFilter..gbTracks..lbTimePlusMinus..Caption +#: filter.dfm:35 +msgid "by" +msgstr "" + +#. frmFilter..gbTracks..lbTimeDays..Caption +#: filter.dfm:42 +msgid "day(s), " +msgstr "" + +#. frmFilter..gbTracks..lbTimeHours..Caption +#: filter.dfm:49 +msgid "hour(s), " +msgstr "" + +#. frmFilter..gbTracks..lbTimeMinutes..Caption +#: filter.dfm:56 +msgid "minute(s)," +msgstr "" + +#. frmFilter..gbTracks..lbTimeSeconds..Caption +#: filter.dfm:63 +msgid "second(s)" +msgstr "" + +#. frmFilter..gbTracks..cbTrackTitle..Hint +#: filter.dfm:70 +msgid "Title for new tracks" +msgstr "" + +#. frmFilter..gbTracks..cbTrackTitle..Caption +#: filter.dfm:72 +msgid "Tit&le" +msgstr "" + +#. frmFilter..gbTracks..edTrackTitle..Text +#: filter.dfm:84 +msgid "ACTIVE LOG # %Y%m%d" +msgstr "" + +#. frmFilter..gbTracks..cbTrackSplit..Hint +#: filter.dfm:91 +msgid "Split track into several tracks depending on date of " +"trackpoint" +msgstr "" + +#. frmFilter..gbTracks..cbTrackSplit..Caption +#: filter.dfm:92 +msgid "&Split" +msgstr "" + +#. frmFilter..gbTracks..cbTrackTime..Hint +#: filter.dfm:100 +msgid "Shift all tracks" +msgstr "" + +#. frmFilter..gbTracks..cbTrackTime..Caption +#: filter.dfm:101 +msgid "&Move" +msgstr "" + +#. frmFilter..gbTracks..cbTrackStart..Hint +#: filter.dfm:193 +msgid "Take only trackpoints starting at" +msgstr "" + +#. frmFilter..gbTracks..cbTrackStart..Caption +#: filter.dfm:194 +msgid "Start at" +msgstr "" + +#. frmFilter..gbTracks..cbTrackStop..Caption +#: filter.dfm:234 +msgid "stop at" +msgstr "" + +#. frmFilter..gbTracks..cbTrackPack..Hint +#: filter.dfm:273 +msgid "Pack all tracks into one track (No duplicate " +"timestamps)" +msgstr "" + +#. frmFilter..gbTracks..cbTrackPack..Caption +#: filter.dfm:274 +msgid "&Pack (or)" +msgstr "" + +#. frmFilter..gbTracks..cbTrackMerge..Hint +#: filter.dfm:283 +msgid "Merge all tracks into one track" +msgstr "" + +#. frmFilter..gbTracks..cbTrackMerge..Caption +#: filter.dfm:284 +msgid "Merge" +msgstr "" + +#. frmFilter..gbRoutes..Caption +#: filter.dfm:295 +msgid "&Routes && Tracks" +msgstr "" + +#. frmFilter..gbRoutes..lbRouteSimplifyCount..Caption +#: filter.dfm:303 +msgid "limit to" +msgstr "" + +#. frmFilter..gbRoutes..lbRouteSimplifyText..Caption +#: filter.dfm:311 +msgid "Points" +msgstr "" + +#. frmFilter..gbRoutes..cbRouteSimplify..Hint +#: filter.dfm:318 +msgid "Simplify routes and tracks by limited number of " +"points" +msgstr "" + +#. frmFilter..gbRoutes..cbRouteSimplify..Caption +#: filter.dfm:319 +msgid "Simplify" +msgstr "" + +#. frmFilter..gbRoutes..edRoutesSimplifyMaxPoints..Hint +#: filter.dfm:328 +msgid "Upper limit of points for routes and " +"tracks" +msgstr "" + +#. frmFilter..gbRoutes..edRoutesSimplifyMaxPoints..Text +#: filter.dfm:333 +msgid "50 " +msgstr "" + +#. frmFilter..gbRoutes..cbReverse..Hint +#: filter.dfm:352 +msgid "Reverse routes and tracks" +msgstr "" + +#. frmFilter..gbRoutes..cbReverse..Caption +#: filter.dfm:353 +msgid "Reverse" +msgstr "" + +#. frmFilter..pnBottom..btnOK..Caption +#: filter.dfm:370 +msgid "OK" +msgstr "" + +#. frmFilter..pnBottom..BitBtn1..Caption +#: filter.dfm:406 +msgid "File based filters" +msgstr "" + +#. frmFilter..gbWaypoints..Caption +#: filter.dfm:426 +#. frmMain..Panel2..cbWaypoints..Caption +#: main.dfm:373 +msgid "&Waypoints" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptMergeDupLoc..Hint +#: filter.dfm:452 +msgid "Merge waypoints with duplicate locations" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptMergeDupLoc..Caption +#: filter.dfm:453 +msgid "locations" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptMergeDupNames..Hint +#: filter.dfm:462 +msgid "Merge waypoints with duplicate \"short " +"name\"" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptMergeDupNames..Caption +#: filter.dfm:463 +msgid "\"short names\"" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptMergeDistance..Hint +#: filter.dfm:472 +msgid "Merge waypoints separated by less then" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptMergeDistance..Caption +#: filter.dfm:473 +msgid "Radius" +msgstr "" + +#. frmFilter..gbWaypoints..cobWayptMergeDist....Items.Strings +#: filter.dfm:487 +msgid "Feet" +msgstr "" + +#. frmFilter..gbWaypoints..cobWayptMergeDist....Items.Strings +#: filter.dfm:488 +#: filter.pas:163 +msgid "Miles" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptSort..Hint +#: filter.dfm:505 +msgid "Sort waypoints by \"short name\" or by " +"description" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptSort..Caption +#: filter.dfm:506 +msgid "Sort" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptMergeDups..Hint +#: filter.dfm:514 +msgid "Merge duplicate waypoints" +msgstr "" + +#. frmFilter..gbWaypoints..cbWayptMergeDups..Caption +#: filter.dfm:515 +msgid "Duplicatates" +msgstr "" + +#. frmMain..Caption +#: main.dfm:6 +msgid "GPSBabelGUI-2" +msgstr "" + +#. frmMain..Panel1..lbInputFile..Caption +#: main.dfm:78 +msgid "&Input file" +msgstr "" + +#. frmMain..Panel1..lbOutputFile..Caption +#: main.dfm:86 +msgid "Out&put file" +msgstr "" + +#. frmMain..Panel1..lbInputFormat..Caption +#: main.dfm:94 +msgid "Input &format" +msgstr "" + +#. frmMain..Panel1..lbOutputFormat..Caption +#: main.dfm:101 +msgid "Output f&ormat" +msgstr "" + +#. frmMain..Panel1..chbInputDevice..Caption +#: main.dfm:150 +#. frmMain..Panel1..chbOutputDevice..Caption +#: main.dfm:199 +msgid "Device" +msgstr "" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#: main.dfm:162 +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:211 +msgid "USB" +msgstr "" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#: main.dfm:163 +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:212 +msgid "COM1" +msgstr "" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#: main.dfm:164 +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:213 +msgid "COM2" +msgstr "" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#: main.dfm:165 +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:214 +msgid "COM3" +msgstr "" + +#. frmMain..Panel1..cbInputDevice....Items.Strings +#: main.dfm:166 +#. frmMain..Panel1..cbOutputDevice....Items.Strings +#: main.dfm:215 +msgid "COM4" +msgstr "" + +#. frmMain..Panel2..lbWhat..Caption +#: main.dfm:234 +msgid "What ?" +msgstr "" + +#. frmMain..Panel2..cbRoutes..Caption +#: main.dfm:384 +msgid "&Routes" +msgstr "" + +#. frmMain..Panel2..btnFilter..Caption +#: main.dfm:404 +#. frmMain..ActionList1..acFilterSelect..Caption +#: main.dfm:907 +msgid "&Filter" +msgstr "" + +#. frmMain..Panel2..btnProcess..Caption +#: main.dfm:428 +#. frmMain..ActionList1..acConvert..Caption +#: main.dfm:900 +msgid "let's go" +msgstr "" + +#. frmMain..memoOutput..Font.Name +#: main.dfm:455 +msgid "Fixedsys" +msgstr "" + +#. frmMain..stbMain......Text +#: main.dfm:473 +msgid "http://sourceforge.net/projects/gpsbabel" +msgstr "" + +#. frmMain..OpenDialog..Filter +#: main.dfm:480 +msgid "Garmin Mapsource|*.gdb|Garmin Mapsource mps|*.mps|All " +"files|*.*" +msgstr "" + +#. frmMain..ActionList1..acConvert..Category +#: main.dfm:899 +#. frmMain..ActionList1..acFilterSelect..Category +#: main.dfm:906 +msgid "Babel" +msgstr "" + +#. frmMain..ActionList1..acFileExit..Category +#: main.dfm:912 +msgid "File" +msgstr "" + +#. frmMain..ActionList1..acFileExit..Caption +#: main.dfm:913 +msgid "E&xit" +msgstr "" + +#. frmMain..ActionList1..acHelpAbout..Category +#: main.dfm:918 +#. frmMain..ActionList1..acHelpIntro..Category +#: main.dfm:923 +#. frmMain..ActionList1..acHelpReadme..Category +#: main.dfm:927 +msgid "Help" +msgstr "" + +#. frmMain..ActionList1..acHelpAbout..Caption +#: main.dfm:919 +msgid "&About" +msgstr "" + +#. frmMain..ActionList1..acHelpIntro..Caption +#: main.dfm:924 +msgid "&Intro" +msgstr "" + +#. frmMain..ActionList1..acHelpReadme..Caption +#: main.dfm:928 +#. frmReadme..Caption +#: readme.dfm:6 +msgid "GPSBabel README" +msgstr "" + +#. frmMain..MainMenu1..mnuFile..Caption +#: main.dfm:937 +msgid "&File" +msgstr "" + +#. frmMain..MainMenu1..mnuHelp..Caption +#: main.dfm:943 +msgid "&Help" +msgstr "" + +#: main.pas:249 +msgid "All files|*.*" +msgstr "" + +#: main.pas:338 +msgid "|All files|*.*" +msgstr "" + +#: main.pas:377 +msgid "File %s not found." +msgstr "" + +#: main.pas:394 +msgid "File \"%s\" exists ! Overwrite ?" +msgstr "" + +#: main.pas:395 +msgid "Warning" +msgstr "" + +#: main.pas:420 +msgid "Could not run \"gpsbabel.exe\"!" +msgstr "" + +#: main.pas:429 +msgid "Converted successfully from \"%s\" to " +"\"%s\"." +msgstr "" + +#: main.pas:430 +msgid "Success" +msgstr "" + diff --git a/win32/gui-2/utils.pas b/win32/gui-2/utils.pas new file mode 100644 index 000000000..f114227c7 --- /dev/null +++ b/win32/gui-2/utils.pas @@ -0,0 +1,210 @@ +unit utils; + +{ + Copyright (C) 2005 Olaf Klein, o.k.klein@t-online.de + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111 USA +} + +interface + +uses + gnugettextD4, + Windows, SysUtils, Classes, Registry; + +function gpsbabel(const CommandLine: string; Output: TStrings): Boolean; + +function GetShortName(const PathName: string): string; +procedure StoreProfile(const Tag: Integer; const Value: string); +function ReadProfile(const Tag: Integer): string; + +function BackupProperties(Instance: TObject; Properties: TStrings; Backup: TStringList): Boolean; +procedure RestoreProperties(Instance: TObject; Backup: TStringList); + +implementation + +uses + common; + +function GetShortName(const PathName: string): string; +var + buffer: array[0..4095] of Char; + len: DWORD; +begin + len := Windows.GetShortPathName(PChar(PathName), @buffer, sizeof(buffer)); + SetString(Result, buffer, len); +end; + +function gpsbabel(const CommandLine: string; Output: TStrings): Boolean; +var + hRead, hWrite: THandle; + ProcessInfo: TProcessInformation; + SecurityAttr: TSecurityAttributes; + StartupInfo: TStartupInfo; + sCmd: string; + + BytesRead, BytesDone: DWORD; + buffer: packed array[0..512] of Char; + Error: DWORD; + s: string; + +begin + Result := False; + + sCmd := SysUtils.Format('%s %s ', [gpsbabel_exe, CommandLine]); + +{ i := WinExec(PChar(sCmd), SW_SHOWNORMAL); + if (i <> 33) then + begin + MessageBox(0, 'There was an error.', 'Uhps', MB_OK); + Exit; + end; +} + SecurityAttr.nLength := sizeof (TSECURITYATTRIBUTES); + SecurityAttr.bInheritHandle := true; + SecurityAttr.lpSecurityDescriptor := nil; + + if not CreatePipe(hRead, hWrite, @SecurityAttr, 0) then + raise eGPSBabelError.Create('Konnte "NamedPipe" nicht anlegen!'); + + try + + if not FileExists(gpsbabel_exe) then + raise eGPSBabelError.Create('gpsbabel.exe wurde nicht gefunden!'); + + FillChar (StartupInfo, Sizeof (StartupInfo), #0); + + StartupInfo.cb := Sizeof (StartupInfo); + StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; + StartupInfo.wShowWindow := SW_HIDE and SW_SHOWMINNOACTIVE; + StartupInfo.hStdInput := GetStdHandle (STD_INPUT_HANDLE); + StartupInfo.hStdOutput:= hWrite; + StartupInfo.hStdError := hWrite; + + FillChar(ProcessInfo, SizeOf(ProcessInfo), #0); + + if not CreateProcess ( + nil, // lpApplicationName // pointer to name of executable module + // sCmd includes both the exec name and the command line parms in this call + pchar (sCmd), // lpCommandLine, // pointer to command line string + nil, // lpProcessAttributes, // pointer to process security attributes + nil, // lpThreadAttributes, // pointer to thread security attributes + true, // bInheritHandles, // handle inheritance flag + CREATE_NEW_CONSOLE, // dwCreationFlags, // creation flags + nil, // lpEnvironment, // pointer to new environment block + nil, // lpCurrentDirectory, // pointer to current directory name + StartupInfo, // lpStartupInfo, // pointer to STARTUPINFO + ProcessInfo) // lpProcessInformation // pointer to PROCESS_INFORMATION + then + begin + Error := GetLastError; + raise eGPSBabelError.CreateFmt( + 'gpsbabel.exe konnte nicht gestartet werden (Fehler %d).', [Error]); + end; + + while (WaitforSingleObject (ProcessInfo.hProcess, 0)) <> WAIT_OBJECT_0 do sleep(100); + + if not GetExitCodeProcess(ProcessInfo.hProcess, Error) then Error := 0; + + if ((Error <> 0) and (Error <> 1)) then + raise eGPSBabelError.CreateFmt('Schade, "gpsbabel.exe" verlies uns mit Fehler 0x%x (%d)', [Error, Error]); + + s := ''; + + PeekNamedPipe(hRead, nil, 0, nil, @BytesRead, nil); + + while (BytesRead > 0) do + begin + ReadFile(hRead, Buffer, SizeOf(buffer)-1, BytesDone, nil); + buffer[BytesDone] := #0; + s := s + string(buffer); + + Dec(BytesRead, BytesDone); + end; + + Output.Clear; + Output.SetText(PChar(s)); + + Result := True; + + finally + CloseHandle (hRead); + CloseHandle (hWrite); + end; +end; + +procedure StoreProfile(const Tag: Integer; const Value: string); +var + reg: TRegistry; + str: string; +begin + if (Tag <= 0) or (Tag > High(Profile)) then Exit; + + str := Profile[Tag]; + reg := TRegistry.Create; + try + reg.RootKey := HKEY_CURRENT_USER; + if reg.OpenKey('\SOFTWARE\GPSBabel', True) then + begin + reg.WriteString(str, Value); + end; + finally + reg.Free; + end; +end; + +function ReadProfile(const Tag: Integer): string; +var + reg: TRegistry; + str: string; +begin + if (Tag <= 0) or (Tag > High(Profile)) then Exit; + + str := Profile[Tag]; + + reg := TRegistry.Create; + try + reg.RootKey := HKEY_CURRENT_USER; + if reg.OpenKey('\SOFTWARE\GPSBabel', True) then + begin + try + Result := reg.ReadString(str); + except + Result := ''; + end; + end; + finally + reg.Free; + end; +end; + + +function BackupProperties(Instance: TObject; Properties: TStrings; Backup: TStringList): Boolean; +var + List: TStringList; +begin + List := TStringList.Create; + try + Backup.Assign(List); + finally + List.Free; + end; +end; + +procedure RestoreProperties(Instance: TObject; Backup: TStringList); +begin +end; + +end. -- 2.30.2